Changeset 5208 for branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3

Timestamp:

2015-04-13T15:08:59+02:00 (9 years ago)

Author:

davestorkey

Message:

Merge in changes from trunk up to 5021.

Location:

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3

Files:

• ice.F90 (modified) (18 diffs)
• iceini.F90 (modified) (5 diffs)
• limadv.F90 (modified) (1 diff)
• limcons.F90 (modified) (2 diffs)
• limdiahsb.F90 (modified) (8 diffs)
• limdyn.F90 (modified) (12 diffs)
• limhdf.F90 (modified) (1 diff)
• limistate.F90 (modified) (11 diffs)
• limitd_me.F90 (modified) (12 diffs)
• limitd_th.F90 (modified) (24 diffs)
• limrhg.F90 (modified) (36 diffs)
• limrst.F90 (modified) (1 diff)
• limsbc.F90 (modified) (9 diffs)
• limthd.F90 (modified) (26 diffs)
• limthd_dh.F90 (modified) (37 diffs)
• limthd_dif.F90 (modified) (44 diffs)
• limthd_ent.F90 (modified) (4 diffs)
• limthd_lac.F90 (modified) (28 diffs)
• limthd_sal.F90 (modified) (5 diffs)
• limtrp.F90 (modified) (14 diffs)
• limupdate1.F90 (modified) (7 diffs)
• limupdate2.F90 (modified) (8 diffs)
• limvar.F90 (modified) (23 diffs)
• limwri.F90 (modified) (15 diffs)
• par_ice.F90 (modified) (2 diffs)
• thd_ice.F90 (modified) (5 diffs)

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

@@ -105 +105 @@
    !! ** Global variables                                                 |
    !!-------------|-------------|---------------------------------|-------|
-   !! a_i         | a_i_b       |    Ice concentration            |       |
+   !! a_i         | a_i_1d      |    Ice concentration            |       |
    !! v_i         |      -      |    Ice volume per unit area     | m     |
    !! v_s         |      -      |    Snow volume per unit area    | m     |
@@ -111 +111 @@
    !! oa_i        !      -      !    Sea ice areal age content    | day   |
    !! e_i         !      -      !    Ice enthalpy                 | 10^9 J| 
-   !!      -      ! q_i_b       !    Ice enthalpy per unit vol.   | J/m3  | 
+   !!      -      ! q_i_1d      !    Ice enthalpy per unit vol.   | J/m3  | 
    !! e_s         !      -      !    Snow enthalpy                | 10^9 J| 
-   !!      -      ! q_s_b       !    Snow enthalpy per unit vol.  | J/m3  | 
+   !!      -      ! q_s_1d      !    Snow enthalpy per unit vol.  | J/m3  | 
    !!                                                                     |
    !!-------------|-------------|---------------------------------|-------|
@@ -120 +120 @@
    !!-------------|-------------|---------------------------------|-------|
    !!                                                                     |
-   !! ht_i        | ht_i_b      |    Ice thickness                | m     |
-   !! ht_s        ! ht_s_b      |    Snow depth                   | m     |
-   !! sm_i        ! sm_i_b      |    Sea ice bulk salinity        ! ppt   |
-   !! s_i         ! s_i_b       |    Sea ice salinity profile     ! ppt   |
+   !! ht_i        | ht_i_1d     |    Ice thickness                | m     |
+   !! ht_s        ! ht_s_1d     |    Snow depth                   | m     |
+   !! sm_i        ! sm_i_1d     |    Sea ice bulk salinity        ! ppt   |
+   !! s_i         ! s_i_1d      |    Sea ice salinity profile     ! ppt   |
    !! o_i         !      -      |    Sea ice Age                  ! days  |
-   !! t_i         ! t_i_b       |    Sea ice temperature          ! K     |
-   !! t_s         ! t_s_b       |    Snow temperature             ! K     |
-   !! t_su        ! t_su_b      |    Sea ice surface temperature  ! K     |
+   !! t_i         ! t_i_1d      |    Sea ice temperature          ! K     |
+   !! t_s         ! t_s_1d      |    Snow temperature             ! K     |
+   !! t_su        ! t_su_1d     |    Sea ice surface temperature  ! K     |
    !!                                                                     |
    !! notes: the ice model only sees a bulk (i.e., vertically averaged)   |
@@ -142 +142 @@
    !! ***         Category-summed state variables (diagnostic)        *** |
    !! ******************************************************************* |
-   !! at_i        | at_i_b      |    Total ice concentration      |       |
+   !! at_i        | at_i_1d     |    Total ice concentration      |       |
    !! vt_i        |      -      |    Total ice vol. per unit area | m     |
    !! vt_s        |      -      |    Total snow vol. per unit ar. | m     |
@@ -170 +170 @@
    REAL(wp), PUBLIC ::   om               !: relaxation constant
    REAL(wp), PUBLIC ::   cw               !: drag coefficient for oceanic stress
-   REAL(wp), PUBLIC ::   angvg            !: turning angle for oceanic stress
    REAL(wp), PUBLIC ::   pstar            !: determines ice strength (N/M), Hibler JPO79
    REAL(wp), PUBLIC ::   c_rhg            !: determines changes in ice strength
@@ -176 +175 @@
    REAL(wp), PUBLIC ::   ecc              !: eccentricity of the elliptical yield curve
    REAL(wp), PUBLIC ::   ahi0             !: sea-ice hor. eddy diffusivity coeff. (m2/s)
-   REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s) !SB
-   REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses !SB
-   REAL(wp), PUBLIC ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy
+   REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s)
+   REAL(wp), PUBLIC ::   relast           !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 
+   REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses 
    REAL(wp), PUBLIC ::   hminrhg          !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity
 
@@ -223 +222 @@
    REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( ecc * ecc )
    REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cw
-   REAL(wp), PUBLIC ::   sangvg, cangvg   !: sin and cos of the turning angle for ocean stress
-   REAL(wp), PUBLIC ::   pstarh           !: pstar / 2.0
+
+   !                                     !!** switch for presence of ice or not 
+   REAL(wp), PUBLIC ::   rswitch
+
+   !                                     !!** define some parameters 
+   REAL(wp), PUBLIC, PARAMETER ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy
+   REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number 
+   REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number 
+   REAL(wp), PUBLIC, PARAMETER ::   epsi20   = 1.e-20_wp  !: small number 
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce   !: surface ocean velocity used in ice dynamics
@@ -247 +253 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw     !: Variation of snow mass over 1 time step     [Kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice     !: Variation of ice mass over 1 time step      [Kg/m2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: Variation of snow mass over 1 time step due to sublimation [Kg/m2]
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni     !: snow ice growth 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw     !: lateral ice growth 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog     !: bottom ice growth 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn     !: dynamical ice growth 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom     !: vertical bottom melt 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum     !: vertical surface melt
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res     !: production (growth+melt) due to limupdate
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr     !: snow precipitation on ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw    !: snow-ocean mass exchange over 1 time step [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr    !: snow precipitation on ice over 1 time step [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub    !: snow sublimation over 1 time step [kg/m2]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice    !: ice-ocean mass exchange over 1 time step [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni    !: snow ice growth component of wfx_ice [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw    !: lateral ice growth component of wfx_ice [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog    !: bottom ice growth component of wfx_ice [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn    !: dynamical ice growth component of wfx_ice [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom    !: bottom melt component of wfx_ice [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum    !: surface melt component of wfx_ice [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2]
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s]
@@ -323 +329 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   smt_i          !: mean sea ice salinity averaged over all categories [PSU]
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   at_i_typ     !: total area   contained in each ice type [m^2]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   vt_i_typ     !: total volume contained in each ice type [m^3]
-
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s        !: Snow temperatures [K]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s        !: Snow ...      
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e_i_cat    !: ! go to trash
       
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i        !: ice temperatures          [K]
@@ -350 +351 @@
    !! * Old values of global variables
    !!--------------------------------------------------------------------------
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   old_v_s, old_v_i               !: snow and ice volumes
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   old_a_i, old_smv_i, old_oa_i   !: ???
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_s                        !: snow heat content
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_i                        !: ice temperatures
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   old_u_ice, old_v_ice           !: ice velocity (gv6 and gv7)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b               !: snow and ice volumes
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, smv_i_b, oa_i_b     !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity
       
 
@@ -368 +369 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_fl  , d_sm_i_gd                 !:
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_se  , d_sm_i_si  , d_sm_i_la    !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_oa_i_thd , d_oa_i_trp , s_i_newice   !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_oa_i_thd , d_oa_i_trp                !:
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_s_thd  , d_e_s_trp     !:
@@ -377 +378 @@
    !! * Ice thickness distribution variables
    !!--------------------------------------------------------------------------
-   ! REMOVE
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_types      !: Vector connecting types and categories
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ice_cat_bounds !: Matrix containing the integer upper and 
-   !                                                                       !  lower boundaries of ice thickness categories
-   ! REMOVE
-   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_ncat_types !: nb of thickness categories in each ice type
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories 
-   ! REMOVE
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hi_max_typ     !: Boundary of ice thickness categories in thickness space
 
    !!--------------------------------------------------------------------------
@@ -409 +402 @@
    LOGICAL , PUBLIC                                      ::   ln_limdiaout  !: flag for ice diag (T) or not (F)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd     !: thermodynamic growth rates 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   izero
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   !: transport of ice volume
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vs   !: transport of snw volume
@@ -432 +424 @@
       INTEGER :: ice_alloc
       !
-      INTEGER :: ierr(20), ii
+      INTEGER :: ierr(19), ii
       !!-----------------------------------------------------------------
 
@@ -462 +454 @@
          &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) )
 
-      ii = ii + 1
-      ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , q_s(jpi,jpj) , STAT=ierr(ii) )
-
       ! * Ice global state variables
       ii = ii + 1
@@ -477 +466 @@
          &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) )
       ii = ii + 1
-      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , at_i_typ(jpi,jpj,jpm) ,                            &
-         &      e_s(jpi,jpj,nlay_s,jpl) , vt_i_typ(jpi,jpj,jpm) , e_i_cat(jpi,jpj,jpl) , STAT=ierr(ii) )
-      ii = ii + 1
-      ALLOCATE( t_i(jpi,jpj,jkmax,jpl) , e_i(jpi,jpj,jkmax,jpl) , s_i(jpi,jpj,jkmax,jpl) , STAT=ierr(ii) )
+      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) ,                            &
+         &      e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( t_i(jpi,jpj,nlay_i+1,jpl) , e_i(jpi,jpj,nlay_i+1,jpl) , s_i(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) )
 
       ! * Moments for advection
@@ -496 +485 @@
          &      STAT=ierr(ii) )
       ii = ii + 1
-      ALLOCATE( sxe (jpi,jpj,jkmax,jpl) , sye (jpi,jpj,jkmax,jpl) , sxxe(jpi,jpj,jkmax,jpl) ,     &
-         &      syye(jpi,jpj,jkmax,jpl) , sxye(jpi,jpj,jkmax,jpl)                           , STAT=ierr(ii) )
+      ALLOCATE( sxe (jpi,jpj,nlay_i+1,jpl) , sye (jpi,jpj,nlay_i+1,jpl) , sxxe(jpi,jpj,nlay_i+1,jpl) ,     &
+         &      syye(jpi,jpj,nlay_i+1,jpl) , sxye(jpi,jpj,nlay_i+1,jpl)                           , STAT=ierr(ii) )
 
       ! * Old values of global variables
       ii = ii + 1
-      ALLOCATE( old_v_s  (jpi,jpj,jpl) , old_v_i  (jpi,jpj,jpl) , old_e_s(jpi,jpj,nlay_s,jpl) ,     &
-         &      old_a_i  (jpi,jpj,jpl) , old_smv_i(jpi,jpj,jpl) , old_e_i(jpi,jpj,jkmax ,jpl) ,     &
-         &      old_oa_i (jpi,jpj,jpl)                                                        ,     &
-         &      old_u_ice(jpi,jpj)     , old_v_ice(jpi,jpj)                                   , STAT=ierr(ii) )
+      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     &
+         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) ,     &
+         &      oa_i_b (jpi,jpj,jpl)                                                        ,     &
+         &      u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)                                   , STAT=ierr(ii) )
 
       ! * Increment of global variables
@@ -511 +500 @@
          &      d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) ,   &     
          &      d_sm_i_fl(jpi,jpj,jpl) , d_sm_i_gd (jpi,jpj,jpl) , d_sm_i_se  (jpi,jpj,jpl) , d_sm_i_si  (jpi,jpj,jpl) ,   &
-         &      d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) , s_i_newice (jpi,jpj,jpl) ,   &
+         &      d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) ,   &
          &     STAT=ierr(ii) )
       ii = ii + 1
-      ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,jkmax,jpl) , d_u_ice_dyn(jpi,jpj) ,     &
-         &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,jkmax,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) )
+      ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i,jpl) , d_u_ice_dyn(jpi,jpj) ,     &
+         &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) )
       
       ! * Ice thickness distribution variables
       ii = ii + 1
-      ALLOCATE( ice_types(jpl) , ice_cat_bounds(jpm,2) , ice_ncat_types  (jpm) ,     &
-         &      hi_max (0:jpl) , hi_mean(jpl)          , hi_max_typ(0:jpl,jpm) , STAT=ierr(ii) )
+      ALLOCATE( hi_max(0:jpl), hi_mean(jpl),  STAT=ierr(ii) )
 
       ! * Ice diagnostics
       ii = ii + 1
-      ALLOCATE( dv_dt_thd(jpi,jpj,jpl) ,     &
-         &      izero    (jpi,jpj,jpl)  , diag_trp_vi(jpi,jpj) , diag_trp_vs(jpi,jpj), diag_trp_ei(jpi,jpj), diag_trp_es(jpi,jpj),     & 
-         &      diag_heat_dhc(jpi,jpj) ,  STAT=ierr(ii) )
+      ALLOCATE( dv_dt_thd(jpi,jpj,jpl),    &
+         &      diag_trp_vi(jpi,jpj), diag_trp_vs  (jpi,jpj), diag_trp_ei(jpi,jpj),   & 
+         &      diag_trp_es(jpi,jpj), diag_heat_dhc(jpi,jpj),  STAT=ierr(ii) )
 
       ice_alloc = MAXVAL( ierr(:) )

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90

@@ -66 +66 @@
       !
       !                                ! adequation jpk versus ice/snow layers/categories
-      IF( jpl   > jpk  .OR.  jpm    > jpk .OR.                                    &
-          jkmax > jpk  .OR.  nlay_s > jpk      )   CALL ctl_stop( 'STOP',         &
+      IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk )   &
+         &      CALL ctl_stop( 'STOP',                     &
          &     'ice_init: the 3rd dimension of workspace arrays is too small.',   &
          &     'use more ocean levels or less ice/snow layers/categories.' )
@@ -89 +89 @@
       CALL lim_itd_ini                 ! ice thickness distribution initialization
       !
+      CALL lim_itd_me_init             ! ice thickness distribution initialization
       !                                ! Initial sea-ice state
       IF( .NOT. ln_rstart ) THEN              ! start from rest
@@ -173 +174 @@
       !!              limistate (only) and is changed to 99 m in ice_init
       !!------------------------------------------------------------------
-      INTEGER  ::   jl, jm               ! dummy loop index
+      INTEGER  ::   jl                   ! dummy loop index
       REAL(wp) ::   zc1, zc2, zc3, zx1   ! local scalars
       !!------------------------------------------------------------------
@@ -184 +185 @@
       ! 1) Ice thickness distribution parameters initialization    
       !------------------------------------------------------------------------------!
-
-      !- Types boundaries (integer)
-      !----------------------------
-      ice_cat_bounds(1,1) = 1
-      ice_cat_bounds(1,2) = jpl
-
-      !- Number of ice thickness categories in each ice type
-      DO jm = 1, jpm
-         ice_ncat_types(jm) = ice_cat_bounds(jm,2) - ice_cat_bounds(jm,1) + 1 
-      END DO
-
-      !- Make the correspondence between thickness categories and ice types
-      !---------------------------------------------------------------------
-      DO jm = 1, jpm       !over types
-         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) !over thickness categories
-            ice_types(jl) = jm
-         END DO
-      END DO
-
       IF(lwp) THEN  
-         WRITE(numout,*) ' Number of ice types jpm =      ', jpm
          WRITE(numout,*) ' Number of ice categories jpl = ', jpl
-         DO jm = 1, jpm
-            WRITE(numout,*) ' Ice type ', jm
-            WRITE(numout,*) ' Number of thickness categories ', ice_ncat_types(jm)
-            WRITE(numout,*) ' Thickness category boundaries  ', ice_cat_bounds(jm,1:2)
-         END DO
-         WRITE(numout,*) 'Ice type vector', ice_types(1:jpl)
-         WRITE(numout,*)
       ENDIF
 
@@ -218 +192 @@
       !----------------------------------
       hi_max(:) = 0._wp
-      hi_max_typ(:,:) = 0._wp
-
-      !- Type 1 - undeformed ice
-      zc1 =  3._wp / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp )
+
+      zc1 =  3._wp / REAL( jpl, wp )
       zc2 = 10._wp * zc1
       zc3 =  3._wp
 
-      DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
-         zx1 = REAL( jl-1 , wp ) / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp )
+      DO jl = 1, jpl
+         zx1 = REAL( jl-1, wp ) / REAL( jpl, wp )
          hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
       END DO
 
-      !- Fill in the hi_max_typ vector, useful in other circumstances
-      ! Tricky trick: hi_max_typ is actually not used in the code and will be removed in a
-      ! next flyspray at this time, the tricky trick will also be removed (Martin, march 08)
-      DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
-         hi_max_typ(jl,1) = hi_max(jl)
-      END DO
-
-      IF(lwp) WRITE(numout,*) ' Thickness category boundaries independently of ice type '
+      IF(lwp) WRITE(numout,*) ' Thickness category boundaries '
       IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl)
 
-      IF(lwp) WRITE(numout,*) ' Thickness category boundaries inside ice types '
-      IF(lwp) THEN 
-         DO jm = 1, jpm
-            WRITE(numout,*) ' Type number ', jm
-            WRITE(numout,*) ' hi_max_typ : ', hi_max_typ(0:ice_ncat_types(jm),jm)
-         END DO
-      ENDIF
       !
       DO jl = 1, jpl

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

@@ -30 +30 @@
    PUBLIC   lim_adv_x   ! called by lim_trp
    PUBLIC   lim_adv_y   ! called by lim_trp
-
-   REAL(wp)  ::   epsi20 = 1.e-20_wp   ! constant values
 
    !! * Substitutions

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

@@ -73 +73 @@
       !! ** Method  : Arithmetics
       !!---------------------------------------------------------------------
-      INTEGER                               , INTENT(in   ) ::   ksum   !: number of categories
-      INTEGER                               , INTENT(in   ) ::   klay   !: number of vertical layers
-      REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl), INTENT(in   ) ::   pin   !: input field
-      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(  out) ::   pout   !: output field
+      INTEGER                                  , INTENT(in   ) ::   ksum   !: number of categories
+      INTEGER                                  , INTENT(in   ) ::   klay   !: number of vertical layers
+      REAL(wp), DIMENSION(jpi,jpj,nlay_i+1,jpl), INTENT(in   ) ::   pin   !: input field
+      REAL(wp), DIMENSION(jpi,jpj)             , INTENT(  out) ::   pout   !: output field
       !
       INTEGER ::   jk, jl   ! dummy loop indices
@@ -175 +175 @@
          zei_b  = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) )
          zfw_b  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
-            &                   wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) ) * area(:,:) * tms(:,:) )
+            &                   wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
+            &             ) * area(:,:) * tms(:,:) )
          zfs_b  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
-            &                   sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) )
+            &                   sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &
+            &                 ) * area(:,:) * tms(:,:) )
          zft_b  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
-            &                 - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) ) * area(:,:) / unit_fac * tms(:,:) )
+            &                 - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
+            &                  ) * area(:,:) / unit_fac * tms(:,:) )
 
       ELSEIF( icount == 1 ) THEN
 
          zfs  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  &
-            &                 sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) ) * area(:,:) * tms(:,:) ) - zfs_b
+            &                 sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
+            &                ) * area(:,:) * tms(:,:) ) - zfs_b
          zfw  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  &
-            &                 wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) ) * area(:,:) * tms(:,:) ) - zfw_b
+            &                 wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    &
+            &                ) * area(:,:) * tms(:,:) ) - zfw_b
          zft  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  & 
-            &               - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) ) * area(:,:) / unit_fac * tms(:,:) ) - zft_b
+            &               - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   &
+            &                ) * area(:,:) / unit_fac * tms(:,:) ) - zft_b
  
          zvi  = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zvi_b ) * r1_rdtice - zfw 

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

@@ -35 +35 @@
    !!PUBLIC   lim_diahsb_rst   ! routine called by ice_init.F90
 
-   REAL(dp) ::   frc_sal, frc_vol   ! global forcing trends
-   REAL(dp) ::   bg_grme            ! global ice growth+melt trends
-   REAL(wp) ::   epsi06 = 1.e-6_wp  ! small number
+   real(wp) ::   frc_sal, frc_vol   ! global forcing trends
+   real(wp) ::   bg_grme            ! global ice growth+melt trends
 
    !! * Substitutions
@@ -58 +57 @@
       !!---------------------------------------------------------------------------
       !!
-      REAL(dp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc
-      REAL(dp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni, zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn 
-      REAL(dp)   ::   zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn
-      REAL(dp)   ::   zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub  
-      REAL(dp)   ::   zbg_hfx_dhc, zbg_hfx_spr
-      REAL(dp)   ::   zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in   
-      REAL(dp)   ::   zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw
-      REAL(dp)   ::   z_frc_vol, z_frc_sal, z_bg_grme 
-      REAL(dp)   ::   z1_area                     !    -     -
-      REAL(dp)   ::   zinda, zindb
+      real(wp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc
+      real(wp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni,   &
+      &               zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn 
+      real(wp)   ::   zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn
+      real(wp)   ::   zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub  
+      real(wp)   ::   zbg_hfx_dhc, zbg_hfx_spr
+      real(wp)   ::   zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in   
+      real(wp)   ::   zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw
+      real(wp)   ::   z_frc_vol, z_frc_sal, z_bg_grme 
+      real(wp)   ::   z1_area                     !    -     -
+      REAL(wp)   ::   ztmp
       !!---------------------------------------------------------------------------
       IF( nn_timing == 1 )   CALL timing_start('lim_diahsb')
@@ -74 +74 @@
 
       ! 1/area
-      z1_area = 1.d0 / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 )
-
-      zinda = MAX( 0.d0 , SIGN( 1.d0 , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) )
+      z1_area = 1._wp / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 )
+
+      rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) )
       ! ----------------------- !
       ! 1 -  Content variations !
@@ -90 +90 @@
 
       ! Volume
-      zbg_vfx     = zinda * glob_sum(      emp(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_vfx_bog = zinda * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_vfx_opw = zinda * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_vfx_sni = zinda * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_vfx_dyn = zinda * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_vfx_bom = zinda * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_vfx_sum = zinda * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_vfx_res = zinda * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_vfx_spr = zinda * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_vfx_snw = zinda * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_vfx_sub = zinda * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
+      ztmp = rswitch * z1_area * r1_rau0 * rday
+      zbg_vfx     = ztmp * glob_sum(     emp(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) )
+      zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) )
 
       ! Salt
-      zbg_sfx     = zinda * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_sfx_bri = zinda * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_sfx_res = zinda * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_sfx_dyn = zinda * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-
-      zbg_sfx_bog = zinda * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_sfx_opw = zinda * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_sfx_sni = zinda * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_sfx_bom = zinda * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
-      zbg_sfx_sum = zinda * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday
+      zbg_sfx     = ztmp * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) )
+      zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) )
+      zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) )
+      zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) )
+
+      zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) )
+      zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) )
+      zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) )
+      zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) )
+      zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) )
 
       ! Heat budget
@@ -152 +153 @@
       ! 3 - Diagnostics writing !
       ! ----------------------- !
-      zindb = MAX( 0.d0 , SIGN( 1.d0 , zbg_ivo - epsi06 ) )
-      !
+      rswitch = MAX( 0._wp , SIGN( 1._wp , zbg_ivo - epsi06 ) )
+      !
+      IF( iom_use('ibgvoltot') )   &
       CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9        )   ! ice volume (km3 equivalent liquid)         
+      IF( iom_use('sbgvoltot') )   &
       CALL iom_put( 'sbgvoltot' , zbg_svo * rhosn * r1_rau0 * 1.e-9        )   ! snw volume (km3 equivalent liquid)       
+      IF( iom_use('ibgarea') )   &
       CALL iom_put( 'ibgarea'   , zbg_are * 1.e-6                          )   ! ice area   (km2)
-      CALL iom_put( 'ibgsaline' , zindb * zbg_sal / MAX( zbg_ivo, epsi06 ) )   ! ice saline (psu)
-      CALL iom_put( 'ibgtemper' , zindb * zbg_tem / MAX( zbg_ivo, epsi06 ) )   ! ice temper (C)
+      IF( iom_use('ibgsaline') )   &
+      CALL iom_put( 'ibgsaline' , rswitch * zbg_sal / MAX( zbg_ivo, epsi06 ) )   ! ice saline (psu)
+      IF( iom_use('ibgtemper') )   &
+      CALL iom_put( 'ibgtemper' , rswitch * zbg_tem / MAX( zbg_ivo, epsi06 ) )   ! ice temper (C)
       CALL iom_put( 'ibgheatco' , zbg_ihc                                  )   ! ice heat content (1.e20 J)        
       CALL iom_put( 'sbgheatco' , zbg_shc                                  )   ! snw heat content (1.e20 J)
+      IF( iom_use('ibgsaltco') )   &
       CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9        )   ! ice salt content (psu*km3 equivalent liquid)        
 
@@ -203 +210 @@
       CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9                          )   ! vol - forcing     (km3 equivalent liquid) 
       CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9                          )   ! sal - forcing     (psu*km3 equivalent liquid)   
+      IF( iom_use('ibgvolgrm') )   &
       CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9                )   ! vol growth + melt (km3 equivalent liquid)         
 
@@ -243 +251 @@
       ! 2 - initial conservation variables !
       ! ---------------------------------- !
-      !frc_vol = 0.d0                                           ! volume       trend due to forcing
-      !frc_sal = 0.d0                                           ! salt content   -    -   -    -         
-      !bg_grme = 0.d0                                           ! ice growth + melt volume trend
+      !frc_vol = 0._wp                                          ! volume       trend due to forcing
+      !frc_sal = 0._wp                                          ! salt content   -    -   -    -         
+      !bg_grme = 0._wp                                          ! ice growth + melt volume trend
       !
       CALL lim_diahsb_rst( nstart, 'READ' )  !* read or initialize all required files
@@ -279 +287 @@
            IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state '
            IF(lwp) WRITE(numout,*) '~~~~~~~'
-           frc_vol  = 0.d0                                           
-           frc_sal  = 0.d0                                                  
-           bg_grme  = 0.d0                                        
-       ENDIF   
+           frc_vol  = 0._wp                                          
+           frc_sal  = 0._wp                                                 
+           bg_grme  = 0._wp                                       
+       ENDIF
 
      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

@@ -64 +64 @@
       INTEGER  ::   i_j1, i_jpj       ! Starting/ending j-indices for rheology
       REAL(wp) ::   zcoef             ! local scalar
-      REAL(wp), POINTER, DIMENSION(:)   ::   zind           ! i-averaged indicator of sea-ice
+      REAL(wp), POINTER, DIMENSION(:)   ::   zswitch        ! i-averaged indicator of sea-ice
       REAL(wp), POINTER, DIMENSION(:)   ::   zmsk           ! i-averaged of tmask
       REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io   ! ice-ocean velocity
@@ -74 +74 @@
 
       CALL wrk_alloc( jpi, jpj, zu_io, zv_io )
-      CALL wrk_alloc( jpj, zind, zmsk )
+      CALL wrk_alloc( jpj, zswitch, zmsk )
 
       IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only)
@@ -83 +83 @@
          IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
-         old_u_ice(:,:) = u_ice(:,:) * tmu(:,:)
-         old_v_ice(:,:) = v_ice(:,:) * tmv(:,:)
+         u_ice_b(:,:) = u_ice(:,:) * tmu(:,:)
+         v_ice_b(:,:) = v_ice(:,:) * tmv(:,:)
 
          ! Rheology (ice dynamics)
@@ -100 +100 @@
             !
             DO jj = 1, jpj
-               zind(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line
+               zswitch(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line
                zmsk(jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line
             END DO
@@ -110 +110 @@
                i_j1  = njeq
                i_jpj = jpj
-               DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
+               DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
                   i_j1 = i_j1 + 1
                END DO
@@ -120 +120 @@
                i_j1  =  1
                i_jpj = njeq
-               DO WHILE ( i_jpj >= 1 .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
+               DO WHILE ( i_jpj >= 1 .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
                   i_jpj = i_jpj - 1
                END DO
@@ -132 +132 @@
                !                                 ! latitude strip
                i_j1  = 1
-               DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
+               DO WHILE ( i_j1 <= jpj .AND. zswitch(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
                   i_j1 = i_j1 + 1
                END DO
@@ -138 +138 @@
 
                i_jpj  = jpj
-               DO WHILE ( i_jpj >= 1  .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
+               DO WHILE ( i_jpj >= 1  .AND. zswitch(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
                   i_jpj = i_jpj - 1
                END DO
@@ -221 +221 @@
       !
       CALL wrk_dealloc( jpi, jpj, zu_io, zv_io )
-      CALL wrk_dealloc( jpj, zind, zmsk )
+      CALL wrk_dealloc( jpj, zswitch, zmsk )
       !
       IF( nn_timing == 1 )  CALL timing_stop('limdyn')
@@ -241 +241 @@
       !!-------------------------------------------------------------------
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      NAMELIST/namicedyn/ epsd, om, cw, angvg, pstar,   &
+      NAMELIST/namicedyn/ epsd, om, cw, pstar,   &
          &                c_rhg, creepl, ecc, ahi0,     &
-         &                nevp, telast, alphaevp, hminrhg
+         &                nevp, relast, alphaevp, hminrhg
       !!-------------------------------------------------------------------
 
@@ -262 +262 @@
          WRITE(numout,*) '   relaxation constant                              om     = ', om
          WRITE(numout,*) '   drag coefficient for oceanic stress              cw     = ', cw
-         WRITE(numout,*) '   turning angle for oceanic stress                 angvg  = ', angvg
          WRITE(numout,*) '   first bulk-rheology parameter                    pstar  = ', pstar
          WRITE(numout,*) '   second bulk-rhelogy parameter                    c_rhg  = ', c_rhg
@@ -269 +268 @@
          WRITE(numout,*) '   horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0
          WRITE(numout,*) '   number of iterations for subcycling              nevp   = ', nevp
-         WRITE(numout,*) '   timescale for elastic waves                      telast = ', telast
+         WRITE(numout,*) '   ratio of elastic timescale over ice time step    relast = ', relast
          WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp
          WRITE(numout,*) '   min ice thickness for rheology calculations     hminrhg = ', hminrhg
       ENDIF
       !
-      IF( angvg /= 0._wp ) THEN
-         CALL ctl_warn( 'lim_dyn_init: turning angle for oceanic stress not properly coded for EVP ',   &
-            &           '(see limsbc module). We force  angvg = 0._wp'  )
-         angvg = 0._wp
-      ENDIF
-      
       usecc2 = 1._wp / ( ecc * ecc )
       rhoco  = rau0  * cw
-      angvg  = angvg * rad
-      sangvg = SIN( angvg )
-      cangvg = COS( angvg )
-      pstarh = pstar * 0.5_wp
+
+      ! elastic damping
+      telast = relast * rdt_ice
 
       !  Diffusion coefficients.

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

@@ -83 +83 @@
       zdiv0(:, 1 ) = 0._wp
       zdiv0(:,jpj) = 0._wp
-      IF( .NOT.lk_vopt_loop ) THEN
-         zflu (jpi,:) = 0._wp   
-         zflv (jpi,:) = 0._wp
-         zdiv0(1,  :) = 0._wp
-         zdiv0(jpi,:) = 0._wp
-      ENDIF
+      zflu (jpi,:) = 0._wp   
+      zflv (jpi,:) = 0._wp
+      zdiv0(1,  :) = 0._wp
+      zdiv0(jpi,:) = 0._wp
 
       zconv = 1._wp           !==  horizontal diffusion using a Crant-Nicholson scheme  ==!

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

@@ -6 +6 @@
    !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code
    !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
-   !!             -   ! 2012    (C. Rousset) add par_oce (for jp_sal)...bug?
+   !!             -   ! 2014    (C. Rousset) add N/S initializations
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -29 +29 @@
    USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
    USE wrk_nemo         ! work arrays
-   USE cpl_oasis3, ONLY : lk_cpl
 
    IMPLICIT NONE
@@ -36 +35 @@
    PUBLIC   lim_istate      ! routine called by lim_init.F90
 
-   !! * Module variables
    !                          !!** init namelist (namiceini) **
    REAL(wp) ::   thres_sst   ! threshold water temperature for initial sea ice
@@ -56 +54 @@
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -80 +77 @@
       !!
       !! ** Notes   : o_i, t_su, t_s, t_i, s_i must be filled everywhere, even
-      !!              where there is no ice (clem: I do not know why but it is mandatory) 
+      !!              where there is no ice (clem: I do not know why, is it mandatory?) 
       !!
       !! History :
@@ -116 +113 @@
       CALL lim_istate_init     !  reading the initials parameters of the ice
 
-# if defined key_coupled
-      albege(:,:)   = 0.8 * tms(:,:)
-# endif
-
       ! surface temperature
       DO jl = 1, jpl ! loop over categories
@@ -125 +118 @@
          tn_ice(:,:,jl) = rtt * tms(:,:)
       END DO
-      ! Basal temperature is set to the freezing point of seawater in Kelvin
-      t_bo(:,:) = ( tfreez( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:) 
+
+      ! basal temperature (considered at freezing point)
+      t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:) 
 
       IF( ln_limini ) THEN
@@ -133 +127 @@
       ! 2) Basal temperature, ice mask and hemispheric index
       !--------------------------------------------------------------------
-      ! ice if sst <= t-freez + thres_sst
-      DO jj = 1, jpj                                       
+
+      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest
          DO ji = 1, jpi
-            IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN  ; zswitch(ji,jj) = 0._wp * tms(ji,jj)    ! no ice
-            ELSE                                                                                   ; zswitch(ji,jj) = 1._wp * tms(ji,jj)    !    ice
+            IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN 
+               zswitch(ji,jj) = 0._wp * tms(ji,jj)    ! no ice
+            ELSE                                                                                   
+               zswitch(ji,jj) = 1._wp * tms(ji,jj)    !    ice
             ENDIF
          END DO
@@ -144 +140 @@
 
       ! Hemispheric index
-      ! MV 2011 new initialization
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -154 +149 @@
          END DO
       END DO
-      ! END MV 2011 new initialization
 
       !--------------------------------------------------------------------
@@ -299 +293 @@
 
       IF(lwp) THEN 
-         WRITE(numout,*), ' ztests : ', ztests
+         WRITE(numout,*) ' ztests : ', ztests
          IF ( ztests .NE. 4 ) THEN
             WRITE(numout,*)
-            WRITE(numout,*), ' !!!! ALERT                  !!! '
-            WRITE(numout,*), ' !!!! Something is wrong in the LIM3 initialization procedure '
+            WRITE(numout,*) ' !!!! ALERT                  !!! '
+            WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure '
             WRITE(numout,*)
-            WRITE(numout,*), ' *** ztests is not equal to 4 '
-            WRITE(numout,*), ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4
-            WRITE(numout,*), ' zat_i_ini : ', zat_i_ini(i_hemis)
-            WRITE(numout,*), ' zht_i_ini : ', zht_i_ini(i_hemis)
+            WRITE(numout,*) ' *** ztests is not equal to 4 '
+            WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4
+            WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(i_hemis)
+            WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(i_hemis)
          ENDIF ! ztests .NE. 4
       ENDIF

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

@@ -43 +43 @@
    PUBLIC   lim_itd_me_alloc        ! called by iceini.F90
 
-   REAL(wp) ::   epsi20 = 1.e-20_wp   ! constant values
-   REAL(wp) ::   epsi10 = 1.e-10_wp   ! constant values
-   REAL(wp) ::   epsi06 = 1.e-06_wp   ! constant values
-
    !-----------------------------------------------------------------------
    ! Variables shared among ridging subroutines
@@ -149 +145 @@
 
       CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final )
-
-      IF( numit == nstart  )   CALL lim_itd_me_init   ! Initialization (first time-step only)
 
       IF(ln_ctl) THEN
@@ -694 +688 @@
 
       IF( partfun_swi == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975)
-         DO jl = 0, ice_cat_bounds(1,2)       ! only undeformed ice participates
+         DO jl = 0, jpl    
             DO jj = 1, jpj 
                DO ji = 1, jpi
@@ -717 +711 @@
             Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy
          END DO !jl
-         DO jl = 0, ice_cat_bounds(1,2)
+         DO jl = 0, jpl
              athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl)
          END DO
@@ -853 +847 @@
       INTEGER ::   ij                ! horizontal index, combines i and j loops
       INTEGER ::   icells            ! number of cells with aicen > puny
-      REAL(wp) ::   zindb    ! local scalar
       REAL(wp) ::   hL, hR, farea, zdummy, zdummy0, ztmelts    ! left and right limits of integration
       REAL(wp) ::   zsstK            ! SST in Kelvin
@@ -899 +892 @@
       CALL wrk_alloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
       CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
-      CALL wrk_alloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw )
-      CALL wrk_alloc( jpi, jpj, jkmax, jpl, eicen_init )
+      CALL wrk_alloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw )
+      CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, eicen_init )
 
       ! Conservation check
@@ -1037 +1030 @@
             !     / rafting category n1.
             !--------------------------------------------------------------------------
-            vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )
+            vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj)
             vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por )
             vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por
@@ -1043 +1036 @@
             vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj)
             esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj)
-            srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )
+            srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj)
             srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless
 
@@ -1128 +1121 @@
                jj = indxj(ij)
                ! heat content of ridged ice
-               erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 
+               erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) 
                eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj)
                e_i  (ji,jj,jk,jl1)  = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk)
@@ -1195 +1188 @@
          !-------------------------------------------------------------------------------
          !        jl1 looping 1-jpl
-         DO jl2  = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
+         DO jl2  = 1, jpl 
             ! over categories to which ridged ice is transferred
 !CDIR NODEP
@@ -1240 +1233 @@
          END DO                 ! jl2 (new ridges)            
 
-         DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
+         DO jl2 = 1, jpl 
 
 !CDIR NODEP
@@ -1304 +1297 @@
       CALL wrk_dealloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
       CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )
-      CALL wrk_dealloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw )
-      CALL wrk_dealloc( jpi, jpj, jkmax, jpl, eicen_init )
+      CALL wrk_dealloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw )
+      CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, eicen_init )
       !
    END SUBROUTINE lim_itd_me_ridgeshift

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

@@ -6 +6 @@
    !! History :   -   !          (W. H. Lipscomb and E.C. Hunke) CICE (c) original code
    !!            3.0  ! 2005-12  (M. Vancoppenolle) adaptation to LIM-3
-   !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age and types
+   !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age
    !!             -   ! 2007-04  (M. Vancoppenolle) Mass conservation checked
    !!----------------------------------------------------------------------
@@ -46 +46 @@
    PUBLIC   lim_itd_shiftice
 
-   REAL(wp) ::   epsi10 = 1.e-10_wp   !
-   REAL(wp) ::   epsi06 = 1.e-6_wp   !
-
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
@@ -66 +63 @@
       INTEGER, INTENT(in) ::   kt   ! time step index
       !
-      INTEGER ::   ji,jj, jk, jl, ja, jm, jbnd1, jbnd2   ! ice types    dummy loop index         
+      INTEGER ::   ji, jj, jk, jl   ! dummy loop index         
       !
       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
@@ -86 +83 @@
       ! Given thermodynamic growth rates, transport ice between
       ! thickness categories.
-      DO jm = 1, jpm
-         jbnd1 = ice_cat_bounds(jm,1)
-         jbnd2 = ice_cat_bounds(jm,2)
-         IF( ice_ncat_types(jm) > 1 )   CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt )
-      END DO
+      IF( jpl > 1 )   CALL lim_itd_th_rem( 1, jpl, kt )
       !
       CALL lim_var_glo2eqv    ! only for info
@@ -123 +116 @@
             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ')
             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ')
-            DO ja = 1, nlay_i
+            DO jk = 1, nlay_i
                CALL prt_ctl_info(' ')
-               CALL prt_ctl_info(' - Layer : ', ivar1=ja)
+               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
                CALL prt_ctl_info('   ~~~~~~~')
-               CALL prt_ctl(tab2d_1=t_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : t_i      : ')
-               CALL prt_ctl(tab2d_1=e_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : e_i      : ')
+               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ')
+               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ')
             END DO
          END DO
@@ -140 +133 @@
    !
 
-   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, ntyp, kt )
+   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt )
       !!------------------------------------------------------------------
       !!                ***  ROUTINE lim_itd_th_rem ***
@@ -153 +146 @@
       INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point
       INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied
-      INTEGER , INTENT (in) ::   ntyp    ! Number of the type used
       INTEGER , INTENT (in) ::   kt      ! Ocean time step 
       !
@@ -161 +153 @@
       REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars
       REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      -
-      REAL(wp) ::   zx3,             zareamin, zindb   !   -      -
+      REAL(wp) ::   zx3,             zareamin          !   -      -
       CHARACTER (len = 15) :: fieldid
 
@@ -171 +163 @@
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   hL          ! left boundary for the ITD for each thickness
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   hR          ! left boundary for the ITD for each thickness
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zht_i_o     ! old ice thickness
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zht_i_b     ! old ice thickness
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   dummy_es
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdaice, zdvice          ! local increment of ice area and volume
@@ -189 +181 @@
       CALL wrk_alloc( jpi,jpj, zremap_flag )    ! integer
       CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )   ! integer
-      CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es )
+      CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
       CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )   
       CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
@@ -218 +210 @@
          WRITE(numout,*) ' klbnd :       ', klbnd
          WRITE(numout,*) ' kubnd :       ', kubnd
-         WRITE(numout,*) ' ntyp  :       ', ntyp 
       ENDIF
 
@@ -225 +216 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zindb             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) )     !0 if no ice and 1 if yes
-               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb
-               zindb             = 1.0 - MAX( 0.0, SIGN( 1.0, - old_a_i(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes
-               zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX( old_a_i(ji,jj,jl), epsi10 ) * zindb
-               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl) 
+               rswitch             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) )     !0 if no ice and 1 if yes
+               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch
+               rswitch             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i_b(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes
+               zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch
+               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) 
             END DO
          END DO
@@ -274 +265 @@
             !
             zhbnew(ii,ij,jl) = hi_max(jl)
-            IF ( old_a_i(ii,ij,jl) > epsi10 .AND. old_a_i(ii,ij,jl+1) > epsi10 ) THEN
+            IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN
                !interpolate between adjacent category growth rates
-               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_o(ii,ij,jl+1) - zht_i_o(ii,ij,jl) )
-               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) )
-            ELSEIF ( old_a_i(ii,ij,jl) > epsi10) THEN
+               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) )
+               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) )
+            ELSEIF ( a_i_b(ii,ij,jl) > epsi10) THEN
                zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl)
-            ELSEIF ( old_a_i(ii,ij,jl+1) > epsi10) THEN
+            ELSEIF ( a_i_b(ii,ij,jl+1) > epsi10) THEN
                zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1)
             ENDIF
@@ -321 +312 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zhb0(ji,jj) = hi_max_typ(0,ntyp) ! 0eme
-            zhb1(ji,jj) = hi_max_typ(1,ntyp) ! 1er
+            zhb0(ji,jj) = hi_max(0) ! 0eme
+            zhb1(ji,jj) = hi_max(1) ! 1er
 
             zhbnew(ji,jj,klbnd-1) = 0._wp
@@ -343 +334 @@
       !-----------------------------------------------------------------------------------------------
       !- 7.1 g(h) for category 1 at start of time step
-      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_o(:,:,klbnd),         &
+      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd),         &
          &                  g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   &
          &                  hR(:,:,klbnd), zremap_flag )
@@ -368 +359 @@
                   ! Constrain new thickness <= ht_i
                   zdamax = a_i(ii,ij,klbnd) * & 
-                     (1.0 - ht_i(ii,ij,klbnd)/zht_i_o(ii,ij,klbnd)) ! zdamax > 0
+                     (1.0 - ht_i(ii,ij,klbnd)/zht_i_b(ii,ij,klbnd)) ! zdamax > 0
                   !ice area lost due to melting of thin ice
                   zda0   = MIN(zda0, zdamax)
@@ -382 +373 @@
             ELSE ! if ice accretion
                ! ji, a_i > epsi10; zdh0 > 0
-               IF ( ntyp .EQ. 1 ) zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd)) 
+               zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd)) 
                ! zhbnew was 0, and is shifted to the right to account for thin ice
                ! growth in openwater (F0 = f1)
-               IF ( ntyp .NE. 1 ) zhbnew(ii,ij,0) = 0 
-               ! in other types there is
-               ! no open water growth (F0 = 0)
             ENDIF ! zdh0 
 
@@ -493 +481 @@
       CALL wrk_dealloc( jpi,jpj, zremap_flag )    ! integer
       CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )   ! integer
-      CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es )
+      CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es )
       CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )   
       CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
@@ -598 +586 @@
       REAL(wp) ::   zdo_aice           ! ice age times volume transferred
       REAL(wp) ::   zdaTsf             ! aicen*Tsfcn transferred
-      REAL(wp) ::   zindsn             ! snow or not
-      REAL(wp) ::   zindb              ! ice or not
 
       INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions
@@ -726 +712 @@
 
             jl1 = zdonor(ii,ij,jl)
-            zindb             = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) )
-            zworka(ii,ij)   = zdvice(ii,ij,jl) / MAX(v_i(ii,ij,jl1),epsi10) * zindb
+            rswitch             = MAX( 0.0 , SIGN( 1.0 , v_i(ii,ij,jl1) - epsi10 ) )
+            zworka(ii,ij)   = zdvice(ii,ij,jl) / MAX(v_i(ii,ij,jl1),epsi10) * rswitch
             IF( jl1 == jl) THEN   ;   jl2 = jl1+1
             ELSE                    ;   jl2 = jl 
@@ -823 +809 @@
                   ht_i(ji,jj,jl)  =  v_i   (ji,jj,jl) / a_i(ji,jj,jl) 
                   t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl) 
-                  zindsn          =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes
+                  rswitch         =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes
                ELSE
                   ht_i(ji,jj,jl)  = 0._wp
@@ -839 +825 @@
    
 
-   SUBROUTINE lim_itd_th_reb( klbnd, kubnd, ntyp )
+   SUBROUTINE lim_itd_th_reb( klbnd, kubnd )
       !!------------------------------------------------------------------
       !!                ***  ROUTINE lim_itd_th_reb ***
@@ -849 +835 @@
       INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point
       INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied
-      INTEGER , INTENT (in) ::   ntyp    ! number of the ice type involved in the rebinning process
       !
       INTEGER ::   ji,jj, jl   ! dummy loop indices
@@ -889 +874 @@
 
       !------------------------------------------------------------------------------
-      ! 2) Make sure thickness of cat klbnd is at least hi_max_typ(klbnd)
+      ! 2) Make sure thickness of cat klbnd is at least hi_max(klbnd)
       !------------------------------------------------------------------------------
       DO jj = 1, jpj 
          DO ji = 1, jpi 
             IF( a_i(ji,jj,klbnd) > epsi10 ) THEN
-               IF( ht_i(ji,jj,klbnd) <= hi_max_typ(0,ntyp) .AND. hi_max_typ(0,ntyp) > 0._wp ) THEN
-                  a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max_typ(0,ntyp) 
-                  ht_i(ji,jj,klbnd) = hi_max_typ(0,ntyp)
+               IF( ht_i(ji,jj,klbnd) <= hi_max(0) .AND. hi_max(0) > 0._wp ) THEN
+                  a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max(0) 
+                  ht_i(ji,jj,klbnd) = hi_max(0)
                ENDIF
             ENDIF

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

@@ -50 +50 @@
    PUBLIC   lim_rhg        ! routine called by lim_dyn (or lim_dyn_2)
 
-   REAL(wp) ::   epsi10 = 1.e-10_wp   !
-      
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
@@ -119 +117 @@
       CHARACTER (len=50) ::   charout
       REAL(wp) ::   zt11, zt12, zt21, zt22, ztagnx, ztagny, delta                         !
-      REAL(wp) ::   za, zstms, zsang, zmask   ! local scalars
+      REAL(wp) ::   za, zstms, zmask   ! local scalars
+      REAL(wp) ::   zc1, zc2, zc3             ! ice mass
 
       REAL(wp) ::   dtevp              ! time step for subcycling
@@ -125 +124 @@
       REAL(wp) ::   z0, zr, zcca, zccb ! temporary scalars
       REAL(wp) ::   zu_ice2, zv_ice1   !
-      REAL(wp) ::   zddc, zdtc, zzdst   ! delta on corners and on centre
+      REAL(wp) ::   zddc, zdtc         ! delta on corners and on centre
+      REAL(wp) ::   zdst               ! shear at the center of the grid point
       REAL(wp) ::   zdsshx, zdsshy     ! term for the gradient of ocean surface
       REAL(wp) ::   sigma1, sigma2     ! internal ice stress
 
       REAL(wp) ::   zresm         ! Maximal error on ice velocity
-      REAL(wp) ::   zindb         ! ice (1) or not (0)      
       REAL(wp) ::   zdummy        ! dummy argument
       REAL(wp) ::   zintb, zintn  ! dummy argument
@@ -140 +139 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   zcorl1, zcorl2   ! coriolis parameter on U/V points
       REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct , za2ct    ! temporary arrays
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zc1              ! ice mass
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zusw             ! temporary weight for ice strength computation
       REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce1, v_oce1   ! ocean u/v component on U points                           
       REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2, v_oce2   ! ocean u/v component on V points
@@ -147 +144 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   zf1   , zf2      ! arrays for internal stresses
       
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zdd   , zdt      ! Divergence and tension at centre of grid cells
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdt              ! tension at centre of grid cells
       REAL(wp), POINTER, DIMENSION(:,:) ::   zds              ! Shear on northeast corner of grid cells
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zdst             ! Shear on centre of grid cells
-      REAL(wp), POINTER, DIMENSION(:,:) ::   deltat, deltac   ! Delta at centre and corners of grid cells
       REAL(wp), POINTER, DIMENSION(:,:) ::   zs1   , zs2      ! Diagonal stress tensor components zs1 and zs2 
       REAL(wp), POINTER, DIMENSION(:,:) ::   zs12             ! Non-diagonal stress tensor component zs12
@@ -160 +155 @@
 
       CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
-      CALL wrk_alloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                )
-      CALL wrk_alloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds  , zdst  )
-      CALL wrk_alloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
+      CALL wrk_alloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1                )
+      CALL wrk_alloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
+      CALL wrk_alloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
 
 #if  defined key_lim2 && ! defined key_lim2_vp
@@ -179 +174 @@
       !
       !------------------------------------------------------------------------------!
-      ! 1) Ice-Snow mass (zc1), ice strength (zpresh)                                !
+      ! 1) Ice strength (zpresh)                                !
       !------------------------------------------------------------------------------!
       !
       ! Put every vector to 0
-      zpresh (:,:) = 0._wp   ;   zc1   (:,:) = 0._wp
+      delta_i(:,:) = 0._wp   ;
+      zpresh (:,:) = 0._wp   ;  
       zpreshc(:,:) = 0._wp
       u_ice2 (:,:) = 0._wp   ;   v_ice1(:,:) = 0._wp
-      zdd    (:,:) = 0._wp   ;   zdt   (:,:) = 0._wp   ;   zds(:,:) = 0._wp
+      divu_i (:,:) = 0._wp   ;   zdt   (:,:) = 0._wp   ;   zds(:,:) = 0._wp
+      shear_i(:,:) = 0._wp
 
 #if defined key_lim3
@@ -196 +193 @@
 !CDIR NOVERRCHK
          DO ji = 1 , jpi
-            zc1(ji,jj)    = tms(ji,jj) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj) )
 #if defined key_lim3
             zpresh(ji,jj) = tms(ji,jj) *  strength(ji,jj)
@@ -218 +214 @@
                &              tms(ji+1,jj)   * wght(ji+1,jj+1,2,1) + &
                &              tms(ji,jj)     * wght(ji+1,jj+1,1,1)
-            zusw(ji,jj)    = 1.0 / MAX( zstms, epsd )
             zpreshc(ji,jj) = (  zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + &
                &                zpresh(ji,jj+1)   * wght(ji+1,jj+1,1,2) + &
                &                zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + & 
                &                zpresh(ji,jj)     * wght(ji+1,jj+1,1,1)   &
-               &             ) * zusw(ji,jj)
+               &             ) / MAX( zstms, epsd )
          END DO
       END DO
@@ -265 +260 @@
          DO ji = fs_2, fs_jpim1
 
+            zc1 = tms(ji  ,jj  ) * ( rhosn * vt_s(ji  ,jj  ) + rhoic * vt_i(ji  ,jj  ) )
+            zc2 = tms(ji+1,jj  ) * ( rhosn * vt_s(ji+1,jj  ) + rhoic * vt_i(ji+1,jj  ) )
+            zc3 = tms(ji  ,jj+1) * ( rhosn * vt_s(ji  ,jj+1) + rhoic * vt_i(ji  ,jj+1) )
+
             zt11 = tms(ji  ,jj) * e1t(ji  ,jj)
             zt12 = tms(ji+1,jj) * e1t(ji+1,jj)
@@ -275 +274 @@
 
             ! Mass, coriolis coeff. and currents
-            zmass1(ji,jj) = ( zt12*zc1(ji,jj) + zt11*zc1(ji+1,jj) ) / (zt11+zt12+epsd)
-            zmass2(ji,jj) = ( zt22*zc1(ji,jj) + zt21*zc1(ji,jj+1) ) / (zt21+zt22+epsd)
+            zmass1(ji,jj) = ( zt12*zc1 + zt11*zc2 ) / (zt11+zt12+epsd)
+            zmass2(ji,jj) = ( zt22*zc1 + zt21*zc3 ) / (zt21+zt22+epsd)
             zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj)*fcor(ji,jj) + e1t(ji,jj)*fcor(ji+1,jj) )   &
                &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + epsd )
@@ -344 +343 @@
                !  
                !- Divergence, tension and shear (Section a. Appendix B of Hunke & Dukowicz, 2002)
-               !- zdd(:,:), zdt(:,:): divergence and tension at centre of grid cells
+               !- divu_i(:,:), zdt(:,:): divergence and tension at centre of grid cells
                !- zds(:,:): shear on northeast corner of grid cells
                !
@@ -353 +352 @@
                !                      bugs (Martin, for Miguel).
                !
-               !- ALSO: arrays zdd, zdt, zds and delta could 
+               !- ALSO: arrays zdt, zds and delta could 
                !  be removed in the future to minimise memory demand.
                !
@@ -361 +360 @@
                !
                !
-               zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      &
-                  &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  &
-                  &          +e1v(ji,jj)*v_ice(ji,jj)                      &
-                  &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  &
-                  &          )                                             &
-                  &         / area(ji,jj)
+               divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      &
+                  &             -e2u(ji-1,jj)*u_ice(ji-1,jj)                  &
+                  &             +e1v(ji,jj)*v_ice(ji,jj)                      &
+                  &             -e1v(ji,jj-1)*v_ice(ji,jj-1)                  &
+                  &             )                                             &
+                  &            / area(ji,jj)
 
                zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    &
@@ -408 +407 @@
 
                !- Calculate Delta at centre of grid cells
-               zzdst      = (  e2u(ji  , jj) * v_ice1(ji  ,jj)          &
+               zdst      = (  e2u(ji  , jj) * v_ice1(ji  ,jj)          &
                   &          - e2u(ji-1, jj) * v_ice1(ji-1,jj)          &
                   &          + e1v(ji, jj  ) * u_ice2(ji,jj  )          &
@@ -415 +414 @@
                   &         / area(ji,jj)
 
-               delta = SQRT( zdd(ji,jj)*zdd(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zzdst*zzdst ) * usecc2 )  
-               ! MV rewriting
-               ! deltat(ji,jj) = MAX( SQRT(zdd(ji,jj)**2 + (zdt(ji,jj)**2 + zzdst**2)*usecc2), creepl )
-               !!gm faster to replace the line above with simply:
-               !!                deltat(ji,jj) = MAX( delta, creepl )
-               !!gm end  
-               deltat(ji,jj) = delta + creepl
-               ! END MV
+               delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )  
+               delta_i(ji,jj) = delta + creepl
                !-Calculate stress tensor components zs1 and zs2 
                !-at centre of grid cells (see section 3.5 of CICE user's guide).
-               !zs1(ji,jj) = ( zs1(ji,jj) - dtotel*( ( 1._wp - alphaevp) * zs1(ji,jj) +   &
-               !   &          ( delta / deltat(ji,jj) - zdd(ji,jj) / deltat(ji,jj) ) * zpresh(ji,jj) ) )  &       
-               !   &          / ( 1._wp + alphaevp * dtotel )
-
-               !zs2(ji,jj) = ( zs2(ji,jj) - dtotel * ( ( 1._wp - alphaevp ) * ecc2 * zs2(ji,jj) -   &
-               !              zdt(ji,jj) / deltat(ji,jj) * zpresh(ji,jj) ) )   &
-               !   &          / ( 1._wp + alphaevp * ecc2 * dtotel )
-
-               ! new formulation from S. Bouillon to help stabilizing the code (no need of alphaevp)
-               zs1(ji,jj) = ( zs1(ji,jj) + dtotel * ( ( zdd(ji,jj) / deltat(ji,jj) - delta / deltat(ji,jj) )  &
+               zs1(ji,jj) = ( zs1(ji,jj) + dtotel * ( ( divu_i(ji,jj) / delta_i(ji,jj) - delta / delta_i(ji,jj) )  &
                   &         * zpresh(ji,jj) ) ) / ( 1._wp + dtotel )
-               zs2(ji,jj) = ( zs2(ji,jj) + dtotel * ( ecci * zdt(ji,jj) / deltat(ji,jj) * zpresh(ji,jj) ) )  &
+               zs2(ji,jj) = ( zs2(ji,jj) + dtotel * ( ecci * zdt(ji,jj) / delta_i(ji,jj) * zpresh(ji,jj) ) )  &
                   &         / ( 1._wp + dtotel )
 
@@ -468 +452 @@
                   &        / ( e1f(ji,jj) * e2f(ji,jj) )
 
-               deltac(ji,jj) = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl
+               zddc = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl
 
                !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide).
-               !zs12(ji,jj) = ( zs12(ji,jj) - dtotel * ( (1.0-alphaevp) * ecc2 * zs12(ji,jj) - zds(ji,jj) /  &
-               !   &          ( 2._wp * deltac(ji,jj) ) * zpreshc(ji,jj) ) )  &
-               !   &          / ( 1._wp + alphaevp * ecc2 * dtotel ) 
-
-               ! new formulation from S. Bouillon to help stabilizing the code (no need of alphaevp)
                zs12(ji,jj) = ( zs12(ji,jj) + dtotel *  &
-                  &          ( ecci * zds(ji,jj) / ( 2._wp * deltac(ji,jj) ) * zpreshc(ji,jj) ) )  &
+                  &          ( ecci * zds(ji,jj) / ( 2._wp * zddc ) * zpreshc(ji,jj) ) )  &
                   &          / ( 1.0 + dtotel ) 
 
@@ -513 +492 @@
                DO ji = fs_2, fs_jpim1
                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj)
-                  zsang        = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg
                   z0           = zmass1(ji,jj)/dtevp
 
@@ -523 +501 @@
                      (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj))
                   zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + &
-                     za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj))
-                  zcca         = z0+za*cangvg
-                  zccb         = zcorl1(ji,jj)+za*zsang
+                     za*(u_oce1(ji,jj))
+                  zcca         = z0+za
+                  zccb         = zcorl1(ji,jj)
                   u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask 
 
@@ -536 +514 @@
 #endif
 #if defined key_bdy
-         ! clem: change u_ice and v_ice at the boundary for each iteration
          CALL bdy_ice_lim_dyn( 'U' )
 #endif         
@@ -546 +523 @@
 
                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj)
-                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg
                   z0           = zmass2(ji,jj)/dtevp
                   ! SB modif because ocean has no slip boundary condition
@@ -555 +531 @@
                      (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj))
                   zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + &
-                     za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj))
-                  zcca         = z0+za*cangvg
-                  zccb         = zcorl2(ji,jj)+za*zsang
+                     za2ct(ji,jj) + za*(v_oce2(ji,jj))
+                  zcca         = z0+za
+                  zccb         = zcorl2(ji,jj)
                   v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask
 
@@ -568 +544 @@
 #endif
 #if defined key_bdy
-         ! clem: change u_ice and v_ice at the boundary for each iteration
          CALL bdy_ice_lim_dyn( 'V' )
 #endif         
@@ -578 +553 @@
                DO ji = fs_2, fs_jpim1
                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj)
-                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg
                   z0           = zmass2(ji,jj)/dtevp
                   ! SB modif because ocean has no slip boundary condition
@@ -588 +562 @@
                      (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj))
                   zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + &
-                     za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj))
-                  zcca         = z0+za*cangvg
-                  zccb         = zcorl2(ji,jj)+za*zsang
+                     za2ct(ji,jj) + za*(v_oce2(ji,jj))
+                  zcca         = z0+za
+                  zccb         = zcorl2(ji,jj)
                   v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask
 
@@ -601 +575 @@
 #endif
 #if defined key_bdy
-         ! clem: change u_ice and v_ice at the boundary for each iteration
          CALL bdy_ice_lim_dyn( 'V' )
 #endif         
@@ -610 +583 @@
                DO ji = fs_2, fs_jpim1
                   zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj)
-                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg
                   z0           = zmass1(ji,jj)/dtevp
-                  ! SB modif because ocean has no slip boundary condition
-                  ! GG Bug
-                  !                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)      &
-                  !                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj))   &
-                  !                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)      &
                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   &
@@ -624 +591 @@
                      (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj))
                   zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + &
-                     za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj))
-                  zcca         = z0+za*cangvg
-                  zccb         = zcorl1(ji,jj)+za*zsang
+                     za*(u_oce1(ji,jj))
+                  zcca         = z0+za
+                  zccb         = zcorl1(ji,jj)
                   u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask 
                END DO ! ji
@@ -636 +603 @@
 #endif
 #if defined key_bdy
-         ! clem: change u_ice and v_ice at the boundary for each iteration
          CALL bdy_ice_lim_dyn( 'U' )
 #endif         
@@ -666 +632 @@
 !CDIR NOVERRCHK
          DO ji = fs_2, fs_jpim1
-            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - epsi10 ) ) 
-            !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , epsi10 )
             zdummy = vt_i(ji,jj)
             IF ( zdummy .LE. hminrhg ) THEN
@@ -683 +647 @@
 #endif
 #if defined key_bdy
-      ! clem: change u_ice and v_ice at the boundary
       CALL bdy_ice_lim_dyn( 'U' )
       CALL bdy_ice_lim_dyn( 'V' )
@@ -690 +653 @@
       DO jj = k_j1+1, k_jpj-1 
          DO ji = fs_2, fs_jpim1
-            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - epsi10 ) ) 
-            !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , epsi10 )
             zdummy = vt_i(ji,jj)
             IF ( zdummy .LE. hminrhg ) THEN
@@ -713 +674 @@
 !CDIR NOVERRCHK
          DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi
-            !- zdd(:,:), zdt(:,:): divergence and tension at centre 
+            !- divu_i(:,:), zdt(:,:): divergence and tension at centre 
             !- zds(:,:): shear on northeast corner of grid cells
-            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - epsi10 ) ) 
-            !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , epsi10 )
             zdummy = vt_i(ji,jj)
             IF ( zdummy .LE. hminrhg ) THEN
 
-               zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      &
-                  &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  &
-                  &          +e1v(ji,jj)*v_ice(ji,jj)                      &
-                  &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  &
-                  &         )                                              &
-                  &         / area(ji,jj)
+               divu_i(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      &
+                  &             -e2u(ji-1,jj)*u_ice(ji-1,jj)                  &
+                  &             +e1v(ji,jj)*v_ice(ji,jj)                      &
+                  &             -e1v(ji,jj-1)*v_ice(ji,jj-1)                  &
+                  &            )                                              &
+                  &            / area(ji,jj)
 
                zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    &
@@ -747 +706 @@
                   &        * tmi(ji+1,jj) * tmi(ji+1,jj+1)
 
-               zdst(ji,jj) = (  e2u( ji  , jj   ) * v_ice1(ji  ,jj  )    &
+               zdst = (  e2u( ji  , jj   ) * v_ice1(ji  ,jj  )    &
                   &           - e2u( ji-1, jj   ) * v_ice1(ji-1,jj  )    &
                   &           + e1v( ji  , jj   ) * u_ice2(ji  ,jj  )    &
                   &           - e1v( ji  , jj-1 ) * u_ice2(ji  ,jj-1)  ) / area(ji,jj)
 
-!              deltat(ji,jj) = SQRT(    zdd(ji,jj)*zdd(ji,jj)   & 
-!                  &                 + ( zdt(ji,jj)*zdt(ji,jj) + zdst(ji,jj)*zdst(ji,jj) ) * usecc2 & 
-!                  &                          ) + creepl
-               ! MV rewriting
-               delta = SQRT( zdd(ji,jj)*zdd(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst(ji,jj)*zdst(ji,jj) ) * usecc2 )  
-               deltat(ji,jj) = delta + creepl
-               ! END MV
+               delta = SQRT( divu_i(ji,jj)*divu_i(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )  
+               delta_i(ji,jj) = delta + creepl
             
             ENDIF ! zdummy
@@ -773 +727 @@
       DO jj = k_j1+1, k_jpj-1
          DO ji = fs_2, fs_jpim1
-            divu_i (ji,jj) = zdd   (ji,jj)
-            delta_i(ji,jj) = deltat(ji,jj)
             ! begin TECLIM change 
-            zdst(ji,jj)= (  e2u( ji  , jj   ) * v_ice1(ji,jj)           &   
+            zdst= (  e2u( ji  , jj   ) * v_ice1(ji,jj)           &   
                &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)         &   
                &          + e1v( ji  , jj   ) * u_ice2(ji,jj)           &   
                &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1) ) / area(ji,jj) 
-            shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst(ji,jj) * zdst(ji,jj) )
+            shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst )
             ! end TECLIM change
          END DO
@@ -834 +786 @@
       !
       CALL wrk_dealloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
-      CALL wrk_dealloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                )
-      CALL wrk_dealloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds  , zdst  )
-      CALL wrk_dealloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
+      CALL wrk_dealloc( jpi,jpj, u_oce1, u_oce2, u_ice2, v_oce1 , v_oce2, v_ice1                )
+      CALL wrk_dealloc( jpi,jpj, zf1   , zu_ice, zf2   , zv_ice , zdt    , zds  )
+      CALL wrk_dealloc( jpi,jpj, zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 )
 
    END SUBROUTINE lim_rhg

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

@@ -315 +315 @@
       INTEGER :: ji, jj, jk, jl, indx
       REAL(wp) ::   zfice, ziter
-      REAL(wp) ::   zs_inf, z_slope_s, zsmax, zsmin, zalpha, zindb   ! local scalars used for the salinity profile
-      REAL(wp), POINTER, DIMENSION(:)  ::   zs_zero 
+      REAL(wp) ::   zs_inf, z_slope_s, zsmax, zsmin, zalpha   ! local scalars used for the salinity profile
+      REAL(wp), POINTER, DIMENSION(:)   ::   zs_zero 
       REAL(wp), POINTER, DIMENSION(:,:) ::   z2d
       CHARACTER(len=15) ::   znam

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

@@ -32 +32 @@
    USE sbc_oce          ! Surface boundary condition: ocean fields
    USE sbccpl
-   USE cpl_oasis3, ONLY : lk_cpl
-   USE oce       , ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
+   USE oce       , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
    USE albedo           ! albedo parameters
    USE lbclnk           ! ocean lateral boundary condition - MPP exchanges
@@ -51 +50 @@
    PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim
    PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim
-
-   REAL(wp)  ::   epsi10 = 1.e-10   !
-   REAL(wp)  ::   epsi20 = 1.e-20   !
 
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2]
@@ -98 +94 @@
       !!              - fr_i    : ice fraction
       !!              - tn_ice  : sea-ice surface temperature
-      !!              - alb_ice : sea-ice alberdo (lk_cpl=T)
+      !!              - alb_ice : sea-ice albedo (lk_cpl=T)
       !!
       !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
       !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
+      !!              These refs are now obsolete since everything has been revised
+      !!              The ref should be Rousset et al., 2015?
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! number of iteration
-      !
-      INTEGER  ::   ji, jj, jl, jk           ! dummy loop indices
-      REAL(wp) ::   zinda, zemp      ! local scalars
-      REAL(wp) ::   zf_mass         ! Heat flux associated with mass exchange ice->ocean (W.m-2)
-      REAL(wp) ::   zfcm1           ! New solar flux received by the ocean
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace
+      INTEGER, INTENT(in) ::   kt                                   ! number of iteration
+      !
+      INTEGER  ::   ji, jj, jl, jk                                  ! dummy loop indices
+      !
+      REAL(wp) ::   zemp                                            !  local scalars
+      REAL(wp) ::   zf_mass                                         ! Heat flux associated with mass exchange ice->ocean (W.m-2)
+      REAL(wp) ::   zfcm1                                           ! New solar flux received by the ocean
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb_cs, zalb_os     ! 2D/3D workspace
       !!---------------------------------------------------------------------
-      
-      IF( lk_cpl )   CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp )
 
       ! make calls for heat fluxes before it is modified
-      CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface
-      CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) )   ! non-solar flux at ocean surface
-      CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) )  !     solar flux at ice surface
-      CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) )  ! non-solar flux at ice surface
-      CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) )  !     solar flux transmitted thru ice
-      CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )  
-      CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * old_a_i(:,:,:), dim=3 ) )
+      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface
+      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) )   ! non-solar flux at ocean surface
+      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux at ice surface
+      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface
+      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) !     solar flux transmitted thru ice
+      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )  
+      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) )
 
       ! pfrld is the lead fraction at the previous time step (actually between TRP and THD)
@@ -130 +128 @@
             !      heat flux at the ocean surface      !
             !------------------------------------------!
-            zinda   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( 1._wp - pfrld(ji,jj) ) ) ) ! 1 if ice
-
             ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 
             !---------------------------------------------------
-            IF( lk_cpl ) THEN ! be carfeful: not been tested yet
-               ! original line
+            IF( lk_cpl ) THEN 
+               !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )
                zfcm1 = qsr_tot(ji,jj)
-               !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) )
                DO jl = 1, jpl
-                  zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl)
+                  zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl)
                END DO
             ELSE
-               !!!zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + &
-               !!!     &    ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) )
+               !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj)
                zfcm1   = pfrld(ji,jj) * qsr(ji,jj)
                DO jl = 1, jpl
-                  zfcm1   = zfcm1 + old_a_i(ji,jj,jl) * ftr_ice(ji,jj,jl)
+                  zfcm1   = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl)
                END DO
             ENDIF
@@ -182 +176 @@
 
             ! mass flux from ice/ocean
-            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj)
+            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   &
+                           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj)
 
             ! mass flux at the ocean/ice interface
-            fmmflx(ji,jj) = - wfx_ice(ji,jj) * rdt_ice                   ! F/M mass flux save at least for biogeochemical model
-            emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange)
+            fmmflx(ji,jj) = - wfx_ice(ji,jj) * r1_rdtice                    ! F/M mass flux save at least for biogeochemical model
+            emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)       ! mass flux + F/M mass flux (always ice/ocean mass exchange)
             
          END DO
@@ -194 +189 @@
       !      salt flux at the ocean surface      !
       !------------------------------------------!
-      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:)
+      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   &
+         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:)
 
       !-------------------------------------------------------------!
@@ -215 +211 @@
 
       !------------------------------------------------!
-      !    Computation of snow/ice and ocean albedo    !
+      !    Snow/ice albedo (only if sent to coupler)   !
       !------------------------------------------------!
       IF( lk_cpl ) THEN          ! coupled case
-         CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb )                  ! snow/ice albedo
-         alb_ice(:,:,:) =  0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:)   ! Ice albedo (mean clear and overcast skys)
+
+            CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os )
+
+            CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos
+
+            alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
+
+            CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os )
+
       ENDIF
 
@@ -229 +232 @@
          CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl )
       ENDIF
-      !
-      IF( lk_cpl )   CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp )
-      ! 
+
    END SUBROUTINE lim_sbc_flx
 
@@ -344 +345 @@
       ! clem modif
       IF( .NOT. ln_rstart ) THEN
-         iatte(:,:) = 1._wp
-         oatte(:,:) = 1._wp
+         fraqsr_1lev(:,:) = 1._wp
       ENDIF
       !

branches/2014/dev_r4650_UKMO11_restart_functionality/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 :  iatte, oatte
+   USE oce     , ONLY : fraqsr_1lev 
    USE ice            ! LIM: sea-ice variables
    USE par_ice        ! LIM: sea-ice parameters
@@ -43 +43 @@
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
    USE timing         ! Timing
-   USE cpl_oasis3, ONLY : lk_cpl
    USE limcons        ! conservation tests
 
@@ -51 +50 @@
    PUBLIC   lim_thd        ! called by limstp module
    PUBLIC   lim_thd_init   ! called by iceini module
-
-   REAL(wp) ::   epsi10 = 1.e-10_wp   !
 
    !! * Substitutions
@@ -68 +65 @@
       !!                ***  ROUTINE lim_thd  ***       
       !!  
-      !! ** Purpose : This routine manages the ice thermodynamic.
+      !! ** Purpose : This routine manages ice thermodynamics
       !!         
       !! ** Action : - Initialisation of some variables
@@ -74 +71 @@
       !!               at the ice base, snow acc.,heat budget of the leads)
       !!             - selection of the icy points and put them in an array
-      !!             - call lim_vert_ther for vert ice thermodynamic
-      !!             - back to the geographic grid
-      !!             - selection of points for lateral accretion
-      !!             - call lim_lat_acc  for the ice accretion
+      !!             - call lim_thd_dif  for vertical heat diffusion
+      !!             - call lim_thd_dh   for vertical ice growth and melt
+      !!             - call lim_thd_ent  for enthalpy remapping
+      !!             - call lim_thd_sal  for ice desalination
+      !!             - call lim_thd_temp to  retrieve temperature from ice enthalpy
       !!             - back to the geographic grid
       !!     
-      !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90
+      !! ** References : 
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt    ! number of iteration
@@ -89 +87 @@
       REAL(wp) :: zfric_umin = 0._wp        ! lower bound for the friction velocity (cice value=5.e-04)
       REAL(wp) :: zch        = 0.0057_wp    ! heat transfer coefficient
-      REAL(wp) :: zinda, zindb, zareamin 
+      REAL(wp) :: zareamin 
       REAL(wp) :: zfric_u, zqld, zqfr
       !
       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zqsr, zqns
       !!-------------------------------------------------------------------
+      CALL wrk_alloc( jpi, jpj, zqsr, zqns )
+
       IF( nn_timing == 1 )  CALL timing_start('limthd')
 
@@ -99 +101 @@
       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
 
-      !------------------------------------------------------------------------------!
-      ! 1) Initialization of diagnostic variables                                    !
-      !------------------------------------------------------------------------------!
+      !------------------------------------------------------------------------!
+      ! 1) Initialization of some variables                                    !
+      !------------------------------------------------------------------------!
+      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice
+
 
       !--------------------
@@ -112 +116 @@
                DO ji = 1, jpi
                   !0 if no ice and 1 if yes
-                  zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 )  )
+                  rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 )  )
                   !Energy of melting q(S,T) [J.m-3]
-                  e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i )
+                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i )
                   !convert units ! very important that this line is here        
                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 
@@ -124 +128 @@
                DO ji = 1, jpi
                   !0 if no ice and 1 if yes
-                  zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  )
+                  rswitch = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  )
                   !Energy of melting q(S,T) [J.m-3]
-                  e_s(ji,jj,jk,jl) = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s )
+                  e_s(ji,jj,jk,jl) = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s )
                   !convert units ! very important that this line is here
                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac 
@@ -136 +140 @@
       ! 2) Partial computation of forcing for the thermodynamic sea ice model.      !
       !-----------------------------------------------------------------------------!
+
+      !--- Ocean solar and non solar fluxes to be used in zqld
+      IF ( .NOT. lk_cpl ) THEN   ! --- forced case, fluxes to the lead are the same as over the ocean
+         !
+         zqsr(:,:) = qsr(:,:)      ; zqns(:,:) = qns(:,:)
+         !
+      ELSE                       ! --- coupled case, fluxes to the lead are total - intercepted
+         !
+         zqsr(:,:) = qsr_tot(:,:)  ; zqns(:,:) = qns_tot(:,:)
+         !
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  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
+         END DO
+         !
+      ENDIF
 
 !CDIR NOVERRCHK
@@ -141 +165 @@
 !CDIR NOVERRCHK
          DO ji = 1, jpi
-            zinda          = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice
+            rswitch          = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice
             !
             !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
@@ -149 +173 @@
             !           !  temperature and turbulent mixing (McPhee, 1992)
             !
+
             ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- !
-            zqld =  tms(ji,jj) * rdt_ice *                                       &
-               &  ( pfrld(ji,jj)         * ( qsr(ji,jj) * oatte(ji,jj)           &   ! solar heat + clem modif
-               &                           + qns(ji,jj) )                        &   ! non solar heat
-               ! latent heat of precip (note that precip is included in qns but not in qns_ice)
-               &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  &
-               &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) )
+            ! REMARK valid at least in forced mode from clem
+            ! precip is included in qns but not in qns_ice
+            IF ( lk_cpl ) THEN
+               zqld =  tms(ji,jj) * rdt_ice *  &
+                  &    (   zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj)               &   ! pfrld already included in coupled mode
+                  &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *     &   ! heat content of precip
+                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )   &
+                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) )
+            ELSE
+               zqld =  tms(ji,jj) * rdt_ice *  &
+                  &      ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) )    &
+                  &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)  *             &  ! heat content of precip
+                  &      ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )           &
+                  &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) )
+            ENDIF
 
             !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
@@ -167 +201 @@
                fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90
                qlead(ji,jj) = 0._wp
+            ELSE
+               fhld (ji,jj) = 0._wp
             ENDIF
             !
@@ -172 +208 @@
             !clem zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )
             zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin ) 
-            fhtur(ji,jj) = MAX( 0._wp, zinda * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 
+            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 
             ! upper bound for fhtur: we do not want SST to drop below Tfreeze. 
             ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr)   
             ! This is not a clean budget, so that should be corrected at some point
-            fhtur(ji,jj) = zinda * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
+            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
 
             ! -----------------------------------------
@@ -185 +221 @@
             hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         & 
                ! heat flux above the ocean
-               &    +             pfrld(ji,jj)   * ( qns(ji,jj) + qsr(ji,jj) )                                                    &
+               &    +             pfrld(ji,jj)   * ( zqns(ji,jj) + zqsr(ji,jj) )                                                  &
                ! latent heat of precip (note that precip is included in qns but not in qns_ice)
                &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  &
@@ -196 +232 @@
             !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema) 
             !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar
-            hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                                        & 
+            hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                       & 
                ! Non solar heat flux received by the ocean
-               &    +        pfrld(ji,jj) * qns(ji,jj)                                                                                             &
+               &    +        pfrld(ji,jj) * qns(ji,jj)                                                                            &
                ! latent heat of precip (note that precip is included in qns but not in qns_ice)
-               &    +      ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  &
-               &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )                        &
+               &    +      ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)       &
+               &         * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  &
+               &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )       &
                ! heat flux taken from the ocean where there is open water ice formation
-               &    -      qlead(ji,jj) * r1_rdtice                                                                                                &
+               &    -      qlead(ji,jj) * r1_rdtice                                                                               &
                ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth)
-               &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                                              &
+               &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                             &
                &    -      at_i(ji,jj) *  fhld(ji,jj)
 
@@ -256 +293 @@
             !-------------------------
 
-            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
 
@@ -284 +321 @@
             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) )
@@ -306 +343 @@
             CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) )
             CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) )
-
-            CALL tab_2d_1d( nbpb, iatte_1d   (1:nbpb), iatte           , jpi, jpj, npb(1:nbpb) ) 
-            CALL tab_2d_1d( nbpb, oatte_1d   (1:nbpb), oatte           , jpi, jpj, npb(1:nbpb) ) 
 
             CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) )
@@ -338 +372 @@
 
             ! --- 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,:) ) 
                                             
             !---------------------------------!
@@ -354 +388 @@
             !--------------------------------
 
-               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 )
@@ -386 +420 @@
                CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj )
                CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj )
-            !
-            IF( num_sal == 2 ) THEN
                CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj )
-            ENDIF
 
               CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj )
@@ -404 +435 @@
               CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb)   , jpi, jpj )
             !
-            !+++++       temporary stuff for a dummy version
-              CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb)      , jpi, jpj )
-              CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb)      , jpi, jpj )
-              CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new  (1:nbpb)      , jpi, jpj )
-              CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0    (1:nbpb)      , jpi, jpj )
-            !+++++
               CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj)
               CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj )
@@ -482 +507 @@
       ENDIF
       !
+      !
+      CALL wrk_dealloc( jpi, jpj, zqsr, zqns )
+
+      !
       ! conservation test
       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
       !
       IF( nn_timing == 1 )  CALL timing_stop('limthd')
+
    END SUBROUTINE lim_thd 
 
@@ -499 +529 @@
       !!
       INTEGER  ::   ji, jk   ! dummy loop indices
-      REAL(wp) ::   ztmelts, zswitch, zaaa, zbbb, zccc, zdiscrim  ! local scalar 
+      REAL(wp) ::   ztmelts, zaaa, zbbb, zccc, zdiscrim  ! local scalar 
       !!-------------------------------------------------------------------
       ! Recover ice temperature
       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
+            rswitch       =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 
+            t_i_1d(ji,jk) =  rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rtt
          END DO 
       END DO 
@@ -552 +582 @@
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp )
       IF(lwm) WRITE ( numoni, namicethd )
+
+      IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )
       !
       IF(lwp) THEN                          ! control print

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

@@ -26 +26 @@
    USE wrk_nemo       ! work arrays
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE cpl_oasis3, ONLY : lk_cpl
    
    IMPLICIT NONE
@@ -32 +31 @@
 
    PUBLIC   lim_thd_dh   ! called by lim_thd
-
-   REAL(wp) ::   epsi20 = 1.e-20   ! constant values
-   REAL(wp) ::   epsi10 = 1.e-10   !
 
    !!----------------------------------------------------------------------
@@ -112 +108 @@
 
       ! mass and salt flux (clem)
-      REAL(wp) :: zdvres, zswitch_sal, zswitch
+      REAL(wp) :: zdvres, zswitch_sal
 
       ! Heat conservation 
       INTEGER  ::   num_iter_max
-      REAL(wp) ::   zinda, zindq, zindh 
-      REAL(wp), POINTER, DIMENSION(:) ::   zintermelt   ! debug
 
       !!------------------------------------------------------------------
@@ -129 +123 @@
       CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema )
       CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )
-      CALL wrk_alloc( jpij, zintermelt )
-      CALL wrk_alloc( jpij, jkmax, zdeltah, zh_i )
+      CALL wrk_alloc( jpij, nlay_i+1, zdeltah, zh_i )
       CALL wrk_alloc( jpij, icount )
       
@@ -148 +141 @@
       zh_i      (:,:) = 0._wp       
       zdeltah   (:,:) = 0._wp       
-      zintermelt(:)   = 0._wp
       icount    (:)   = 0
 
@@ -156 +148 @@
       DO jk = 1, nlay_i
          DO ji = kideb, kiut
-            h_i_old (ji,jk) = ht_i_b(ji) / REAL( nlay_i )
-            qh_i_old(ji,jk) = q_i_b(ji,jk) * h_i_old(ji,jk)
+            h_i_old (ji,jk) = ht_i_1d(ji) / REAL( nlay_i )
+            qh_i_old(ji,jk) = q_i_1d(ji,jk) * h_i_old(ji,jk)
          ENDDO
       ENDDO
@@ -166 +158 @@
       !
       DO ji = kideb, kiut
-         zinda         = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_b(ji) ) )
-         ztmelts       = zinda * rtt + ( 1._wp - zinda ) * rtt
-
-         zfdum     = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
-         zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 
-
-         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_b(ji) - ztmelts ) )
+         rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )
+         ztmelts       = rswitch * rtt + ( 1._wp - rswitch ) * rtt
+
+         zfdum      = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
+         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 
+
+         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - ztmelts ) )
          zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice )
       END DO
@@ -182 +174 @@
       !------------------------------------------------------------------------------!
       DO ji = kideb, kiut
-         IF( t_s_b(ji,1) > rtt ) THEN !!! Internal melting
+         IF( t_s_1d(ji,1) > rtt ) THEN !!! Internal melting
             ! Contribution to heat flux to the ocean [W.m-2], < 0  
-            hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_b(ji,1) * ht_s_b(ji) * a_i_b(ji) * r1_rdtice
+            hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice
             ! Contribution to mass flux
-            wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * ht_s_b(ji) * a_i_b(ji) * r1_rdtice
+            wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice
             ! updates
-            ht_s_b(ji)   = 0._wp
-            q_s_b (ji,1) = 0._wp
-            t_s_b (ji,1) = rtt
+            ht_s_1d(ji)   = 0._wp
+            q_s_1d (ji,1) = 0._wp
+            t_s_1d (ji,1) = rtt
          END IF
       END DO
@@ -199 +191 @@
       !
       DO ji = kideb, kiut     
-         zh_s(ji) = ht_s_b(ji) / REAL( nlay_s )
+         zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )
       END DO
       !
       DO jk = 1, nlay_s
          DO ji = kideb, kiut
-            zqh_s(ji) =  zqh_s(ji) + q_s_b(ji,jk) * zh_s(ji)
+            zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * zh_s(ji)
          END DO
       END DO
@@ -210 +202 @@
       DO jk = 1, nlay_i
          DO ji = kideb, kiut
-            zh_i(ji,jk) = ht_i_b(ji) / REAL( nlay_i )
-            zqh_i(ji)   = zqh_i(ji) + q_i_b(ji,jk) * zh_i(ji,jk)
+            zh_i(ji,jk) = ht_i_1d(ji) / REAL( nlay_i )
+            zqh_i(ji)   = zqh_i(ji) + q_i_1d(ji,jk) * zh_i(ji,jk)
          END DO
       END DO
@@ -238 +230 @@
          !-----------
          ! thickness change
-         zcoeff = ( 1._wp - ( 1._wp - at_i_b(ji) )**betas ) / at_i_b(ji) 
+         zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )**betas ) / at_i_1d(ji) 
          zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn
          ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K)
@@ -244 +236 @@
          IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp
          ! heat flux from snow precip (>0, W.m-2)
-         hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_b(ji) * zqprec(ji) * r1_rdtice
+         hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
          ! mass flux, <0
-         wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_b(ji) * zdh_s_pre(ji) * r1_rdtice
+         wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice
          ! update thickness
-         ht_s_b    (ji) = MAX( 0._wp , ht_s_b(ji) + zdh_s_pre(ji) )
+         ht_s_1d    (ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) )
 
          !---------------------
@@ -255 +247 @@
          ! thickness change
          IF( zdh_s_pre(ji) > 0._wp ) THEN
-         zindq          = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zqprec(ji) + epsi20 ) )
-         zdh_s_mel (ji) = - zindq * zq_su(ji) / MAX( zqprec(ji) , epsi20 )
+         rswitch        = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zqprec(ji) + epsi20 ) )
+         zdh_s_mel (ji) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )
          zdh_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting 
          ! heat used to melt snow (W.m-2, >0)
-         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdh_s_mel(ji) * a_i_b(ji) * zqprec(ji) * r1_rdtice
+         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdh_s_mel(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice
          ! snow melting only = water into the ocean (then without snow precip), >0
-         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_b(ji) * zdh_s_mel(ji) * r1_rdtice
+         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_mel(ji) * r1_rdtice
          
          ! updates available heat + thickness
          zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) )      
-         ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdh_s_mel(ji) )
-         zh_s  (ji) = ht_s_b(ji) / REAL( nlay_s )
+         ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_mel(ji) )
+         zh_s  (ji) = ht_s_1d(ji) / REAL( nlay_s )
 
          ENDIF
@@ -276 +268 @@
          DO ji = kideb, kiut
             ! thickness change
-            zindh            = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_b(ji) ) ) 
-            zindq            = 1._wp - MAX( 0._wp, SIGN( 1._wp, - q_s_b(ji,jk) + epsi20 ) ) 
-            zdeltah  (ji,jk) = - zindh * zindq * zq_su(ji) / MAX( q_s_b(ji,jk), epsi20 )
+            rswitch          = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) ) 
+            rswitch          = rswitch * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - q_s_1d(ji,jk) + epsi20 ) ) ) 
+            zdeltah  (ji,jk) = - rswitch * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 )
             zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting
             zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)    
             ! heat used to melt snow(W.m-2, >0)
-            hfx_snw_1d(ji)   = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_b(ji) * q_s_b(ji,jk) * r1_rdtice 
+            hfx_snw_1d(ji)   = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_1d(ji) * q_s_1d(ji,jk) * r1_rdtice 
             ! snow melting only = water into the ocean (then without snow precip)
-            wfx_snw_1d(ji)   = wfx_snw_1d(ji) - rhosn * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice
+            wfx_snw_1d(ji)   = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
 
             ! updates available heat + thickness
-            zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_b(ji,jk) )
-            ht_s_b(ji) = MAX( 0._wp , ht_s_b(ji) + zdeltah(ji,jk) )
+            zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) )
+            ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) )
 
          END DO
@@ -305 +297 @@
          ! forced  mode: snow thickness change due to sublimation
          DO ji = kideb, kiut
-            zdh_s_sub(ji)  =  MAX( - ht_s_b(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice )
+            zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice )
             ! Heat flux by sublimation [W.m-2], < 0
             !      sublimate first snow that had fallen, then pre-existing snow
             zcoeff         =      ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) )   * zqprec(ji) +   &
-               &  ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_b(ji,1) )  &
-               &  * a_i_b(ji) * r1_rdtice
+               &  ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_1d(ji,1) )  &
+               &  * a_i_1d(ji) * r1_rdtice
             hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff
             ! Mass flux by sublimation
-            wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_b(ji) * zdh_s_sub(ji) * r1_rdtice
+            wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice
             ! new snow thickness
-            ht_s_b(ji)     =  MAX( 0._wp , ht_s_b(ji) + zdh_s_sub(ji) )
+            ht_s_1d(ji)     =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) )
          END DO
       ENDIF
@@ -322 +314 @@
       DO ji = kideb, kiut
          dh_s_tot(ji)   = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji)
-         zh_s(ji)       = ht_s_b(ji) / REAL( nlay_s )
+         zh_s(ji)       = ht_s_1d(ji) / REAL( nlay_s )
       END DO ! ji
 
@@ -332 +324 @@
       DO jk = 1, nlay_s
          DO ji = kideb,kiut
-            zindh  =  MAX(  0._wp , SIGN( 1._wp, - ht_s_b(ji) + epsi20 )  )
-            q_s_b(ji,jk) = ( 1._wp - zindh ) / MAX( ht_s_b(ji), epsi20 ) *             &
+            rswitch       =  MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) + epsi20 )  )
+            q_s_1d(ji,jk) = ( 1._wp - rswitch ) / MAX( ht_s_1d(ji), epsi20 ) *             &
               &            ( (   MAX( 0._wp, dh_s_tot(ji) )              ) * zqprec(ji) +  &
-              &              ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_b(ji) ) * rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) )
-            zq_s(ji)     =  zq_s(ji) + q_s_b(ji,jk)
+              &              ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_1d(ji) ) * rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus ) )
+            zq_s(ji)     =  zq_s(ji) + q_s_1d(ji,jk)
          END DO
       END DO
@@ -346 +338 @@
       DO jk = 1, nlay_i
          DO ji = kideb, kiut 
-            zEi            = - q_i_b(ji,jk) / rhoic                ! Specific enthalpy of layer k [J/kg, <0]
-
-            ztmelts        = - tmut * s_i_b(ji,jk) + rtt           ! Melting point of layer k [K]
+            zEi            = - q_i_1d(ji,jk) / rhoic                ! Specific enthalpy of layer k [J/kg, <0]
+
+            ztmelts        = - tmut * s_i_1d(ji,jk) + rtt           ! Melting point of layer k [K]
 
             zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0]
@@ -368 +360 @@
             zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0]
 
-            ! Contribution to salt flux (clem: using sm_i_b and not s_i_b(jk) is ok)
-            sfx_sum_1d(ji)   = sfx_sum_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
+            ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+            sfx_sum_1d(ji)   = sfx_sum_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
 
             ! Contribution to heat flux [W.m-2], < 0
-            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice
+            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
 
             ! Total heat flux used in this process [W.m-2], > 0  
-            hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice
+            hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
 
             ! Contribution to mass flux
-            wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice
+            wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
            
             ! record which layers have disappeared (for bottom melting) 
             !    => icount=0 : no layer has vanished
             !    => icount=5 : 5 layers have vanished
-            zindh       = NINT( MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) ) 
-            icount(ji)  = icount(ji) + zindh
+            rswitch     = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) 
+            icount(ji)  = icount(ji) + NINT( rswitch )
             zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )
 
             ! update heat content (J.m-2) and layer thickness
-            qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk)
+            qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk)
             h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
          END DO
@@ -394 +386 @@
       ! update ice thickness
       DO ji = kideb, kiut
-         ht_i_b(ji) =  MAX( 0._wp , ht_i_b(ji) + dh_i_surf(ji) )
+         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) )
       END DO
 
@@ -424 +416 @@
       !clem debug. Just to be sure that enthalpy at nlay_i+1 is null
       DO ji = kideb, kiut
-         q_i_b(ji,nlay_i+1) = 0._wp
+         q_i_1d(ji,nlay_i+1) = 0._wp
       END DO
 
@@ -446 +438 @@
 
                s_i_new(ji)        = zswitch_sal * zfracs * sss_m(ii,ij)  &  ! New ice salinity
-                                  + ( 1. - zswitch_sal ) * sm_i_b(ji) 
+                                  + ( 1. - zswitch_sal ) * sm_i_1d(ji) 
                ! New ice growth
                ztmelts            = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K)
 
-               zt_i_new           = zswitch_sal * t_bo_b(ji) + ( 1. - zswitch_sal) * t_i_b(ji, nlay_i)
+               zt_i_new           = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
                
                zEi                = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
@@ -456 +448 @@
                   &               + rcp  * ( ztmelts-rtt )          
 
-               zEw                = rcp  * ( t_bo_b(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
+               zEw                = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
 
                zdE                = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0)
@@ -462 +454 @@
                dh_i_bott(ji)      = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoic ) )
 
-               q_i_b(ji,nlay_i+1) = -zEi * rhoic                        ! New ice energy of melting (J/m3, >0)
+               q_i_1d(ji,nlay_i+1) = -zEi * rhoic                        ! New ice energy of melting (J/m3, >0)
                
             ENDIF ! fc_bo_i
@@ -477 +469 @@
             ztmelts        = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K)
             
-            zt_i_new       = zswitch_sal * t_bo_b(ji) + ( 1. - zswitch_sal) * t_i_b(ji, nlay_i)
+            zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
             
             zEi            = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)      
@@ -483 +475 @@
                &               + rcp  * ( ztmelts-rtt )          
             
-            zEw            = rcp  * ( t_bo_b(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
+            zEw            = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0)
             
             zdE            = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0)
             
             ! Contribution to heat flux to the ocean [W.m-2], >0  
-            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice
+            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
 
             ! Total heat flux used in this process [W.m-2], <0  
-            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice
+            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
             
             ! Contribution to salt flux, <0
-            sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_b(ji) * zfmdt * r1_rdtice
+            sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_1d(ji) * zfmdt * r1_rdtice
 
             ! Contribution to mass flux, <0
-            wfx_bog_1d(ji) =  wfx_bog_1d(ji) - rhoic * a_i_b(ji) * dh_i_bott(ji) * r1_rdtice
+            wfx_bog_1d(ji) =  wfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * r1_rdtice
 
             ! update heat content (J.m-2) and layer thickness
-            qh_i_old(ji,nlay_i+1) = qh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * q_i_b(ji,nlay_i+1)
+            qh_i_old(ji,nlay_i+1) = qh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * q_i_1d(ji,nlay_i+1)
             h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bott(ji)
          ENDIF
@@ -513 +505 @@
             IF(  zf_tt(ji)  >=  0._wp  .AND. jk > icount(ji) ) THEN   ! do not calculate where layer has already disappeared from surface melting 
 
-               ztmelts = - tmut * s_i_b(ji,jk) + rtt  ! Melting point of layer jk (K)
-
-               IF( t_i_b(ji,jk) >= ztmelts ) THEN !!! Internal melting
-                  zintermelt(ji)    = 1._wp
-
-                  zEi               = - q_i_b(ji,jk) / rhoic        ! Specific enthalpy of melting ice (J/kg, <0)
-
-                  !!zEw               = rcp * ( t_i_b(ji,jk) - rtt )  ! Specific enthalpy of meltwater at T = t_i_b (J/kg, <0)
+               ztmelts = - tmut * s_i_1d(ji,jk) + rtt  ! Melting point of layer jk (K)
+
+               IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting
+
+                  zEi               = - q_i_1d(ji,jk) / rhoic        ! Specific enthalpy of melting ice (J/kg, <0)
+
+                  !!zEw               = rcp * ( t_i_1d(ji,jk) - rtt )  ! Specific enthalpy of meltwater at T = t_i_1d (J/kg, <0)
 
                   zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0)
@@ -533 +524 @@
 
                   ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 
-                  hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_b(ji) * zEi * r1_rdtice
-
-                  ! Contribution to salt flux (clem: using sm_i_b and not s_i_b(jk) is ok)
-                  sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
+                  hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice
+
+                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+                  sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
                                     
                   ! Contribution to mass flux
-                  wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice
+                  wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
 
                   ! update heat content (J.m-2) and layer thickness
-                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk)
+                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk)
                   h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
 
                ELSE                               !!! Basal melting
 
-                  zEi               = - q_i_b(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0)
+                  zEi               = - q_i_1d(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0)
 
                   zEw               = rcp * ( ztmelts - rtt )! Specific enthalpy of meltwater (J/kg, <0)
@@ -568 +559 @@
 
                   ! Contribution to heat flux to the ocean [W.m-2], <0  
-                  hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice
-
-                  ! Contribution to salt flux (clem: using sm_i_b and not s_i_b(jk) is ok)
-                  sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
+                  hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice
+
+                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok)
+                  sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice
                   
                   ! Total heat flux used in this process [W.m-2], >0  
-                  hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_b(ji) * zdE * r1_rdtice
+                  hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice
                   
                   ! Contribution to mass flux
-                  wfx_bom_1d(ji) =  wfx_bom_1d(ji) - rhoic * a_i_b(ji) * zdeltah(ji,jk) * r1_rdtice
+                  wfx_bom_1d(ji) =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice
 
                   ! update heat content (J.m-2) and layer thickness
-                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_b(ji,jk)
+                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk)
                   h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk)
                ENDIF
@@ -603 +594 @@
 !
 !               ! excessive energy is sent to lateral ablation
-!               zinda = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_b(ji) - epsi20 ) )
-!               zq_1cat(ji) =  zinda * rhoic * lfus * at_i_b(ji) / MAX( 1._wp - at_i_b(ji) , epsi20 ) * zdvres ! J.m-2 >=0
+!               rswitch = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_1d(ji) - epsi20 ) )
+!               zq_1cat(ji) =  rswitch * rhoic * lfus * at_i_1d(ji) / MAX( 1._wp - at_i_1d(ji) , epsi20 ) * zdvres ! J.m-2 >=0
 !
 !               ! correct salt and mass fluxes
-!               sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic * r1_rdtice ! this is only a raw approximation
-!               wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_b(ji) * zdvres * r1_rdtice
+!               sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdvres * rhoic * r1_rdtice ! this is only a raw approximation
+!               wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdvres * r1_rdtice
 !            ENDIF
 !         END DO
@@ -617 +608 @@
       !-------------------------------------------
       DO ji = kideb, kiut
-         ht_i_b(ji) =  MAX( 0._wp , ht_i_b(ji) + dh_i_bott(ji) )
+         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_bott(ji) )
       END DO  
 
@@ -628 +619 @@
       DO ji = kideb, kiut
          zq_rema(ji)     = zq_su(ji) + zq_bo(ji) 
-!         zindh           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_b(ji) ) )   ! =1 if snow
+!         zindh           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )   ! =1 if snow
 !         zindq           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - zq_s(ji) + epsi20 ) )
 !         zdeltah  (ji,1) = - zindh * zindq * zq_rema(ji) / MAX( zq_s(ji), epsi20 )
-!         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_b(ji) ) ) ! bound melting
+!         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting
 !         zdh_s_mel(ji)   = zdh_s_mel(ji) + zdeltah(ji,1)    
 !         dh_s_tot (ji)   = dh_s_tot(ji) + zdeltah(ji,1)
-!         ht_s_b   (ji)   = ht_s_b(ji)   + zdeltah(ji,1)
+!         ht_s_1d   (ji)   = ht_s_1d(ji)   + zdeltah(ji,1)
 !        
 !         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * zq_s(ji)                ! update available heat (J.m-2)
 !         ! heat used to melt snow
-!         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_b(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (>0)
+!         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (>0)
 !         ! Contribution to mass flux
-!         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_b(ji) * zdeltah(ji,1) * r1_rdtice
+!         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice
 !    
          ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
          ! Remaining heat flux (W.m-2) is sent to the ocean heat budget
-         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_1cat(ji) + zq_rema(ji) * a_i_b(ji) ) * r1_rdtice
+         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_1cat(ji) + zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice
 
          IF( ln_nicep .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji)
@@ -657 +648 @@
       DO ji = kideb, kiut
          !
-         dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_b(ji) + (rhoic-rau0) * ht_i_b(ji) ) / ( rhosn+rau0-rhoic )  )
-
-         ht_i_b(ji)     = ht_i_b(ji) + dh_snowice(ji)
-         ht_s_b(ji)     = ht_s_b(ji) - dh_snowice(ji)
+         dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic )  )
+
+         ht_i_1d(ji)     = ht_i_1d(ji) + dh_snowice(ji)
+         ht_s_1d(ji)     = ht_s_1d(ji) - dh_snowice(ji)
 
          ! Salinity of snow ice
          ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1
-         zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic + ( 1. - zswitch_sal ) * sm_i_b(ji)
+         zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji)
 
          ! entrapment during snow ice formation
          ! new salinity difference stored (to be used in limthd_ent.F90)
          IF (  num_sal == 2  ) THEN
-            zswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_b(ji) - epsi10 ) )
+            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi10 ) )
             ! salinity dif due to snow-ice formation
-            dsm_i_si_1d(ji) = ( zs_snic - sm_i_b(ji) ) * dh_snowice(ji) / MAX( ht_i_b(ji), epsi10 ) * zswitch     
+            dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi10 ) * rswitch     
             ! salinity dif due to bottom growth 
             IF (  zf_tt(ji)  < 0._wp ) THEN
-               dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_b(ji) ) * dh_i_bott(ji) / MAX( ht_i_b(ji), epsi10 ) * zswitch
+               dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi10 ) * rswitch
             ENDIF
          ENDIF
@@ -686 +677 @@
          
          ! Contribution to heat flux
-         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_b(ji) * zEw * r1_rdtice 
+         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
 
          ! Contribution to salt flux
-         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_b(ji) * zfmdt * r1_rdtice 
+         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice 
           
          ! Contribution to mass flux
          ! All snow is thrown in the ocean, and seawater is taken to replace the volume
-         wfx_sni_1d(ji) = wfx_sni_1d(ji) - a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice
-         wfx_snw_1d(ji) = wfx_snw_1d(ji) + a_i_b(ji) * dh_snowice(ji) * rhosn * r1_rdtice
+         wfx_sni_1d(ji) = wfx_sni_1d(ji) - a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice
+         wfx_snw_1d(ji) = wfx_snw_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhosn * r1_rdtice
 
          ! update heat content (J.m-2) and layer thickness
-         qh_i_old(ji,0) = qh_i_old(ji,0) + dh_snowice(ji) * q_s_b(ji,1) + zfmdt * zEw
+         qh_i_old(ji,0) = qh_i_old(ji,0) + dh_snowice(ji) * q_s_1d(ji,1) + zfmdt * zEw
          h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji)
          
          ! Total ablation (to debug)
-         IF( ht_i_b(ji) <= 0._wp )   a_i_b(ji) = 0._wp
+         IF( ht_i_1d(ji) <= 0._wp )   a_i_1d(ji) = 0._wp
 
       END DO !ji
@@ -711 +702 @@
       !clem bug: we should take snow into account here
       DO ji = kideb, kiut
-         zindh    =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_b(ji) ) ) 
-         t_su_b(ji) =  zindh * t_su_b(ji) + ( 1.0 - zindh ) * rtt
+         rswitch     =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) 
+         t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rtt
       END DO  ! ji
 
@@ -718 +709 @@
          DO ji = kideb,kiut
             ! mask enthalpy
-            zinda        =  MAX(  0._wp , SIGN( 1._wp, - ht_s_b(ji) )  )
-            q_s_b(ji,jk) = ( 1.0 - zinda ) * q_s_b(ji,jk)
-            ! recalculate t_s_b from q_s_b
-            t_s_b(ji,jk) = rtt + ( 1._wp - zinda ) * ( - q_s_b(ji,jk) / ( rhosn * cpic ) + lfus / cpic )
+            rswitch       =  MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) )  )
+            q_s_1d(ji,jk) = ( 1.0 - rswitch ) * q_s_1d(ji,jk)
+            ! recalculate t_s_1d from q_s_1d
+            t_s_1d(ji,jk) = rtt + ( 1._wp - rswitch ) * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic )
          END DO
       END DO
@@ -727 +718 @@
       CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema )
       CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )
-      CALL wrk_dealloc( jpij, zintermelt )
-      CALL wrk_dealloc( jpij, jkmax, zdeltah, zh_i )
+      CALL wrk_dealloc( jpij, nlay_i+1, zdeltah, zh_i )
       CALL wrk_dealloc( jpij, icount )
       !

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

@@ -25 +25 @@
    USE wrk_nemo       ! work arrays
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE cpl_oasis3, ONLY : lk_cpl
+   USE sbc_oce, ONLY : lk_cpl
 
    IMPLICIT NONE
@@ -32 +32 @@
    PUBLIC   lim_thd_dif   ! called by lim_thd
 
-   REAL(wp) ::   epsi10 = 1.e-10_wp    !
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
@@ -75 +74 @@
       !!
       !! ** Inputs / Ouputs : (global commons)
-      !!           surface temperature : t_su_b
-      !!           ice/snow temperatures   : t_i_b, t_s_b
-      !!           ice salinities          : s_i_b
+      !!           surface temperature : t_su_1d
+      !!           ice/snow temperatures   : t_i_1d, t_s_1d
+      !!           ice salinities          : s_i_1d
       !!           number of layers in the ice/snow: nlay_i, nlay_s
       !!           profile of the ice/snow layers : z_i, z_s
-      !!           total ice/snow thickness : ht_i_b, ht_s_b
+      !!           total ice/snow thickness : ht_i_1d, ht_s_1d
       !!
       !! ** External : 
@@ -98 +97 @@
       INTEGER ::   ii, ij      ! temporary dummy loop index
       INTEGER ::   numeq       ! current reference number of equation
-      INTEGER ::   layer       ! vertical dummy loop index 
+      INTEGER ::   jk       ! vertical dummy loop index 
       INTEGER ::   nconv       ! number of iterations in iterative procedure
       INTEGER ::   minnumeqmin, maxnumeqmax
@@ -108 +107 @@
       REAL(wp) ::   zgamma    =  18009._wp    ! for specific heat
       REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13)
-      REAL(wp) ::   zraext_s  =  1.e+8_wp     ! extinction coefficient of radiation in the snow
+      REAL(wp) ::   zraext_s  =  10._wp       ! extinction coefficient of radiation in the snow
       REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity
       REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered as 0°C 
@@ -114 +113 @@
       REAL(wp) ::   zerritmax   ! current maximal error on temperature 
       REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! ice melting point
-      REAL(wp), POINTER, DIMENSION(:) ::   ztsuold     ! old surface temperature (before the iterative procedure )
-      REAL(wp), POINTER, DIMENSION(:) ::   ztsuoldit   ! surface temperature at previous iteration
+      REAL(wp), POINTER, DIMENSION(:) ::   ztsub       ! old surface temperature (before the iterative procedure )
+      REAL(wp), POINTER, DIMENSION(:) ::   ztsubit     ! surface temperature at previous iteration
       REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness
       REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness
@@ -129 +128 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_i    ! Radiation absorbed in the ice
       REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_i    ! Kappa factor in the ice
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztiold      ! Old temperature in the ice
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztib        ! Old temperature in the ice
       REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_i      ! Eta factor in the ice
       REAL(wp), POINTER, DIMENSION(:,:) ::   ztitemp     ! Temporary temperature in the ice to check the convergence
@@ -137 +136 @@
       REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_s    ! Radiation absorbed in the snow
       REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_s    ! Kappa factor in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_s       ! Eta factor in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztstemp      ! Temporary temperature in the snow to check the convergence
-      REAL(wp), POINTER, DIMENSION(:,:) ::   ztsold       ! Temporary temperature in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   z_s          ! Vertical cotes of the layers in the snow
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zindterm   ! Independent term
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zindtbis   ! temporary independent term
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_s      ! Eta factor in the snow
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztstemp     ! Temporary temperature in the snow to check the convergence
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztsb        ! Temporary temperature in the snow
+      REAL(wp), POINTER, DIMENSION(:,:) ::   z_s         ! Vertical cotes of the layers in the snow
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zswiterm    ! Independent term
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zswitbis    ! temporary independent term
       REAL(wp), POINTER, DIMENSION(:,:) ::   zdiagbis
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid   ! tridiagonal system terms
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid     ! tridiagonal system terms
       ! diag errors on heat
-      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini
-      REAL(wp)                        :: zhfx_err
+      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err
       !!------------------------------------------------------------------     
       ! 
       CALL wrk_alloc( jpij, numeqmin, numeqmax, isnow )
-      CALL wrk_alloc( jpij, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw )
+      CALL wrk_alloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw )
       CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu )
-      CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0)
-      CALL wrk_alloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsold, zeta_s, ztstemp, z_s, kjstart=0)
-      CALL wrk_alloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis  )
-      CALL wrk_alloc( jpij, jkmax+2, 3, ztrid )
-
-      CALL wrk_alloc( jpij, zdq, zq_ini )
+      CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0)
+      CALL wrk_alloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0)
+      CALL wrk_alloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis  )
+      CALL wrk_alloc( jpij, nlay_i+3, 3, ztrid )
+
+      CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err )
 
       ! --- diag error on heat diffusion - PART 1 --- !
       zdq(:) = 0._wp ; zq_ini(:) = 0._wp      
       DO ji = kideb, kiut
-         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 ) ) 
+         zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  &
+            &           SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) ) 
       END DO
 
@@ -173 +171 @@
       DO ji = kideb , kiut
          ! is there snow or not
-         isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  )
+         isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  )
          ! surface temperature of fusion
          ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt
          ! layer thickness
-         zh_i(ji) = ht_i_b(ji) / REAL( nlay_i )
-         zh_s(ji) = ht_s_b(ji) / REAL( nlay_s )
+         zh_i(ji) = ht_i_1d(ji) / REAL( nlay_i )
+         zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s )
       END DO
 
@@ -188 +186 @@
       z_i(:,0) = 0._wp   ! vert. coord. of the up. lim. of the 1st ice layer
 
-      DO layer = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer
-         DO ji = kideb , kiut
-            z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / REAL( nlay_s )
-         END DO
-      END DO
-
-      DO layer = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer
-         DO ji = kideb , kiut
-            z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / REAL( nlay_i )
+      DO jk = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer
+         DO ji = kideb , kiut
+            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) / REAL( nlay_s )
+         END DO
+      END DO
+
+      DO jk = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer
+         DO ji = kideb , kiut
+            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) / REAL( nlay_i )
          END DO
       END DO
@@ -217 +215 @@
       DO ji = kideb , kiut
          ! switches
-         isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) )  ) 
+         isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )  ) 
          ! hs > 0, isnow = 1
          zhsu (ji) = hnzst  ! threshold for the computation of i0
-         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_b(ji) / zhsu(ji) ) )     
+         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu(ji) ) )     
 
          i0(ji)    = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) )
@@ -227 +225 @@
          !            a function of the cloud cover
          !
-         !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_b(ji)+10.0)
+         !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_1d(ji)+10.0)
          !formula used in Cice
       END DO
@@ -249 +247 @@
       END DO
 
-      DO layer = 1, nlay_s          ! Radiation through snow
+      DO jk = 1, nlay_s          ! Radiation through snow
          DO ji = kideb, kiut
             !                             ! radiation transmitted below the layer-th snow layer
-            zradtr_s(ji,layer) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,layer) ) ) )
+            zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,jk) ) ) )
             !                             ! radiation absorbed by the layer-th snow layer
-            zradab_s(ji,layer) = zradtr_s(ji,layer-1) - zradtr_s(ji,layer)
+            zradab_s(ji,jk) = zradtr_s(ji,jk-1) - zradtr_s(ji,jk)
          END DO
       END DO
@@ -262 +260 @@
       END DO
 
-      DO layer = 1, nlay_i          ! Radiation through ice
+      DO jk = 1, nlay_i          ! Radiation through ice
          DO ji = kideb, kiut
             !                             ! radiation transmitted below the layer-th ice layer
-            zradtr_i(ji,layer) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,layer) ) ) )
+            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) )
             !                             ! radiation absorbed by the layer-th ice layer
-            zradab_i(ji,layer) = zradtr_i(ji,layer-1) - zradtr_i(ji,layer)
+            zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk)
          END DO
       END DO
 
       DO ji = kideb, kiut           ! Radiation transmitted below the ice
-         !!!ftr_ice_1d(ji) = ftr_ice_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif
          ftr_ice_1d(ji) = zradtr_i(ji,nlay_i) 
       END DO
@@ -282 +279 @@
       !
       DO ji = kideb, kiut        ! Old surface temperature
-         ztsuold  (ji) =  t_su_b(ji)                              ! temperature at the beg of iter pr.
-         ztsuoldit(ji) =  t_su_b(ji)                              ! temperature at the previous iter
-         t_su_b   (ji) =  MIN( t_su_b(ji), ztfs(ji) - ztsu_err )  ! necessary
+         ztsub  (ji) =  t_su_1d(ji)                              ! temperature at the beg of iter pr.
+         ztsubit(ji) =  t_su_1d(ji)                              ! temperature at the previous iter
+         t_su_1d   (ji) =  MIN( t_su_1d(ji), ztfs(ji) - ztsu_err )  ! necessary
          zerrit   (ji) =  1000._wp                                ! initial value of error
       END DO
 
-      DO layer = 1, nlay_s       ! Old snow temperature
-         DO ji = kideb , kiut
-            ztsold(ji,layer) =  t_s_b(ji,layer)
-         END DO
-      END DO
-
-      DO layer = 1, nlay_i       ! Old ice temperature
-         DO ji = kideb , kiut
-            ztiold(ji,layer) =  t_i_b(ji,layer)
+      DO jk = 1, nlay_s       ! Old snow temperature
+         DO ji = kideb , kiut
+            ztsb(ji,jk) =  t_s_1d(ji,jk)
+         END DO
+      END DO
+
+      DO jk = 1, nlay_i       ! Old ice temperature
+         DO ji = kideb , kiut
+            ztib(ji,jk) =  t_i_1d(ji,jk)
          END DO
       END DO
@@ -313 +310 @@
          IF( thcon_i_swi == 0 ) THEN      ! Untersteiner (1964) formula
             DO ji = kideb , kiut
-               ztcond_i(ji,0)        = rcdic + zbeta*s_i_b(ji,1) / MIN(-epsi10,t_i_b(ji,1)-rtt)
+               ztcond_i(ji,0)        = rcdic + zbeta*s_i_1d(ji,1) / MIN(-epsi10,t_i_1d(ji,1)-rtt)
                ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin)
             END DO
-            DO layer = 1, nlay_i-1
+            DO jk = 1, nlay_i-1
                DO ji = kideb , kiut
-                  ztcond_i(ji,layer) = rcdic + zbeta*( s_i_b(ji,layer) + s_i_b(ji,layer+1) ) /  &
-                     MIN(-2.0_wp * epsi10, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt)
-                  ztcond_i(ji,layer) = MAX(ztcond_i(ji,layer),zkimin)
+                  ztcond_i(ji,jk) = rcdic + zbeta*( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  &
+                     MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt)
+                  ztcond_i(ji,jk) = MAX(ztcond_i(ji,jk),zkimin)
                END DO
             END DO
@@ -327 +324 @@
          IF( thcon_i_swi == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T
             DO ji = kideb , kiut
-               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_b(ji,1) / MIN( -epsi10, t_i_b(ji,1)-rtt )   &
-                  &                   - 0.011_wp * ( t_i_b(ji,1) - rtt )  
+               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1)-rtt )   &
+                  &                   - 0.011_wp * ( t_i_1d(ji,1) - rtt )  
                ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
             END DO
-            DO layer = 1, nlay_i-1
+            DO jk = 1, nlay_i-1
                DO ji = kideb , kiut
-                  ztcond_i(ji,layer) = rcdic + 0.090_wp * ( s_i_b(ji,layer) + s_i_b(ji,layer+1) )   &
-                     &                                  / MIN(-2.0_wp * epsi10, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt)   &
-                     &                       - 0.0055_wp* ( t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2.0*rtt )  
-                  ztcond_i(ji,layer) = MAX( ztcond_i(ji,layer), zkimin )
+                  ztcond_i(ji,jk) = rcdic +                                                                     & 
+                     &                 0.090_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                          &
+                     &                 / MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt)   &
+                     &               - 0.0055_wp* ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0*rtt )  
+                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin )
                END DO
             END DO
             DO ji = kideb , kiut
-               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_b(ji,nlay_i) / MIN(-epsi10,t_bo_b(ji)-rtt)   &
-                  &                        - 0.011_wp * ( t_bo_b(ji) - rtt )  
+               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN(-epsi10,t_bo_1d(ji)-rtt)   &
+                  &                        - 0.011_wp * ( t_bo_1d(ji) - rtt )  
                ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin )
             END DO
@@ -357 +355 @@
          END DO
 
-         DO layer = 1, nlay_s-1
-            DO ji = kideb , kiut
-               zkappa_s(ji,layer)  = 2.0 * rcdsn / &
+         DO jk = 1, nlay_s-1
+            DO ji = kideb , kiut
+               zkappa_s(ji,jk)  = 2.0 * rcdsn / &
                   MAX(epsi10,2.0*zh_s(ji))
             END DO
          END DO
 
-         DO layer = 1, nlay_i-1
+         DO jk = 1, nlay_i-1
             DO ji = kideb , kiut
                !-- Ice kappa factors
-               zkappa_i(ji,layer)  = 2.0*ztcond_i(ji,layer)/ &
+               zkappa_i(ji,jk)  = 2.0*ztcond_i(ji,jk)/ &
                   MAX(epsi10,2.0*zh_i(ji)) 
             END DO
@@ -386 +384 @@
          !------------------------------------------------------------------------------|
          !
-         DO layer = 1, nlay_i
-            DO ji = kideb , kiut
-               ztitemp(ji,layer)   = t_i_b(ji,layer)
-               zspeche_i(ji,layer) = cpic + zgamma*s_i_b(ji,layer)/ &
-                  MAX((t_i_b(ji,layer)-rtt)*(ztiold(ji,layer)-rtt),epsi10)
-               zeta_i(ji,layer)    = rdt_ice / MAX(rhoic*zspeche_i(ji,layer)*zh_i(ji), &
+         DO jk = 1, nlay_i
+            DO ji = kideb , kiut
+               ztitemp(ji,jk)   = t_i_1d(ji,jk)
+               zspeche_i(ji,jk) = cpic + zgamma*s_i_1d(ji,jk)/ &
+                  MAX((t_i_1d(ji,jk)-rtt)*(ztib(ji,jk)-rtt),epsi10)
+               zeta_i(ji,jk)    = rdt_ice / MAX(rhoic*zspeche_i(ji,jk)*zh_i(ji), &
                   epsi10)
             END DO
          END DO
 
-         DO layer = 1, nlay_s
-            DO ji = kideb , kiut
-               ztstemp(ji,layer) = t_s_b(ji,layer)
-               zeta_s(ji,layer)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10)
+         DO jk = 1, nlay_s
+            DO ji = kideb , kiut
+               ztstemp(ji,jk) = t_s_1d(ji,jk)
+               zeta_s(ji,jk)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10)
             END DO
          END DO
@@ -407 +405 @@
          !------------------------------------------------------------------------------|
          !
-         DO ji = kideb , kiut
-            ! update of the non solar flux according to the update in T_su
-            qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) )
-
+         IF( .NOT. lk_cpl ) THEN   !--- forced atmosphere case
+            DO ji = kideb , kiut
+               ! update of the non solar flux according to the update in T_su
+               qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_1d(ji) - ztsubit(ji) )
+            END DO
+         ENDIF
+
+         ! Update incoming flux
+         DO ji = kideb , kiut
             ! update incoming flux
             zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation
-               + qns_ice_1d(ji)                  ! non solar total flux 
+               + qns_ice_1d(ji)                   ! non solar total flux 
             ! (LWup, LWdw, SH, LH)
          END DO
@@ -429 +432 @@
          !!ice interior terms (top equation has the same form as the others)
 
-         DO numeq=1,jkmax+2
+         DO numeq=1,nlay_i+3
             DO ji = kideb , kiut
                ztrid(ji,numeq,1) = 0.
                ztrid(ji,numeq,2) = 0.
                ztrid(ji,numeq,3) = 0.
-               zindterm(ji,numeq)= 0.
-               zindtbis(ji,numeq)= 0.
+               zswiterm(ji,numeq)= 0.
+               zswitbis(ji,numeq)= 0.
                zdiagbis(ji,numeq)= 0.
             ENDDO
@@ -442 +445 @@
          DO numeq = nlay_s + 2, nlay_s + nlay_i 
             DO ji = kideb , kiut
-               layer              = numeq - nlay_s - 1
-               ztrid(ji,numeq,1)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer-1)
-               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,layer)*(zkappa_i(ji,layer-1) + &
-                  zkappa_i(ji,layer))
-               ztrid(ji,numeq,3)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer)
-               zindterm(ji,numeq) =  ztiold(ji,layer) + zeta_i(ji,layer)* &
-                  zradab_i(ji,layer)
+               jk              = numeq - nlay_s - 1
+               ztrid(ji,numeq,1)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk-1)
+               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,jk)*(zkappa_i(ji,jk-1) + &
+                  zkappa_i(ji,jk))
+               ztrid(ji,numeq,3)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk)
+               zswiterm(ji,numeq) =  ztib(ji,jk) + zeta_i(ji,jk)* &
+                  zradab_i(ji,jk)
             END DO
          ENDDO
@@ -459 +462 @@
                +  zkappa_i(ji,nlay_i-1) )
             ztrid(ji,numeq,3)  =  0.0
-            zindterm(ji,numeq) =  ztiold(ji,nlay_i) + zeta_i(ji,nlay_i)* &
+            zswiterm(ji,numeq) =  ztib(ji,nlay_i) + zeta_i(ji,nlay_i)* &
                ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 &
-               *  t_bo_b(ji) ) 
+               *  t_bo_1d(ji) ) 
          ENDDO
 
 
          DO ji = kideb , kiut
-            IF ( ht_s_b(ji).gt.0.0 ) THEN
+            IF ( ht_s_1d(ji).gt.0.0 ) THEN
                !
                !------------------------------------------------------------------------------|
@@ -474 +477 @@
                !!snow interior terms (bottom equation has the same form as the others)
                DO numeq = 3, nlay_s + 1
-                  layer =  numeq - 1
-                  ztrid(ji,numeq,1)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer-1)
-                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,layer)*( zkappa_s(ji,layer-1) + &
-                     zkappa_s(ji,layer) )
-                  ztrid(ji,numeq,3)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer)
-                  zindterm(ji,numeq)  =  ztsold(ji,layer) + zeta_s(ji,layer)* &
-                     zradab_s(ji,layer)
+                  jk =  numeq - 1
+                  ztrid(ji,numeq,1)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk-1)
+                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,jk)*( zkappa_s(ji,jk-1) + &
+                     zkappa_s(ji,jk) )
+                  ztrid(ji,numeq,3)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk)
+                  zswiterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk)* &
+                     zradab_s(ji,jk)
                END DO
 
@@ -486 +489 @@
                IF ( nlay_i.eq.1 ) THEN
                   ztrid(ji,nlay_s+2,3)    =  0.0
-                  zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1)* &
-                     t_bo_b(ji) 
+                  zswiterm(ji,nlay_s+2)   =  zswiterm(ji,nlay_s+2) + zkappa_i(ji,1)* &
+                     t_bo_1d(ji) 
                ENDIF
 
-               IF ( t_su_b(ji) .LT. rtt ) THEN
+               IF ( t_su_1d(ji) .LT. rtt ) THEN
 
                   !------------------------------------------------------------------------------|
@@ -503 +506 @@
                   ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0)
                   ztrid(ji,1,3) = zg1s*zkappa_s(ji,0)
-                  zindterm(ji,1) = dzf(ji)*t_su_b(ji)   - zf(ji)
+                  zswiterm(ji,1) = dzf(ji)*t_su_1d(ji)   - zf(ji)
 
                   !!first layer of snow equation
@@ -509 +512 @@
                   ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1)*(zkappa_s(ji,1) + zkappa_s(ji,0)*zg1s)
                   ztrid(ji,2,3)  =  - zeta_s(ji,1)* zkappa_s(ji,1)
-                  zindterm(ji,2) =  ztsold(ji,1) + zeta_s(ji,1)*zradab_s(ji,1)
+                  zswiterm(ji,2) =  ztsb(ji,1) + zeta_s(ji,1)*zradab_s(ji,1)
 
                ELSE 
@@ -526 +529 @@
                      zkappa_s(ji,0) * zg1s )
                   ztrid(ji,2,3)  =  - zeta_s(ji,1)*zkappa_s(ji,1) 
-                  zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) *            &
+                  zswiterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) *            &
                      ( zradab_s(ji,1) +                         &
-                     zkappa_s(ji,0) * zg1s * t_su_b(ji) ) 
+                     zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 
                ENDIF
             ELSE
@@ -536 +539 @@
                !------------------------------------------------------------------------------|
                !
-               IF (t_su_b(ji) .LT. rtt) THEN
+               IF (t_su_1d(ji) .LT. rtt) THEN
                   !
                   !------------------------------------------------------------------------------|
@@ -550 +553 @@
                   ztrid(ji,numeqmin(ji),2)   =  dzf(ji) - zkappa_i(ji,0)*zg1    
                   ztrid(ji,numeqmin(ji),3)   =  zkappa_i(ji,0)*zg1
-                  zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_b(ji) - zf(ji)
+                  zswiterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji)
 
                   !!first layer of ice equation
@@ -557 +560 @@
                      + zkappa_i(ji,0) * zg1 )
                   ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1)*zkappa_i(ji,1)  
-                  zindterm(ji,numeqmin(ji)+1)=  ztiold(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)  
+                  zswiterm(ji,numeqmin(ji)+1)=  ztib(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)  
 
                   !!case of only one layer in the ice (surface & ice equations are altered)
@@ -570 +573 @@
                      ztrid(ji,numeqmin(ji)+1,3)  =  0.0
 
-                     zindterm(ji,numeqmin(ji)+1) =  ztiold(ji,1) + zeta_i(ji,1)* &
-                        ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji) )
+                     zswiterm(ji,numeqmin(ji)+1) =  ztib(ji,1) + zeta_i(ji,1)* &
+                        ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji) )
                   ENDIF
 
@@ -590 +593 @@
                      zg1)  
                   ztrid(ji,numeqmin(ji),3)      =  - zeta_i(ji,1) * zkappa_i(ji,1)
-                  zindterm(ji,numeqmin(ji))     =  ztiold(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + &
-                     zkappa_i(ji,0) * zg1 * t_su_b(ji) ) 
+                  zswiterm(ji,numeqmin(ji))     =  ztib(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + &
+                     zkappa_i(ji,0) * zg1 * t_su_1d(ji) ) 
 
                   !!case of only one layer in the ice (surface & ice equations are altered)
@@ -599 +602 @@
                         zkappa_i(ji,1))
                      ztrid(ji,numeqmin(ji),3)  =  0.0
-                     zindterm(ji,numeqmin(ji)) =  ztiold(ji,1) + zeta_i(ji,1)* &
-                        (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji)) &
-                        + t_su_b(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0
+                     zswiterm(ji,numeqmin(ji)) =  ztib(ji,1) + zeta_i(ji,1)* &
+                        (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji)) &
+                        + t_su_1d(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0
                   ENDIF
 
@@ -620 +623 @@
 
          maxnumeqmax = 0
-         minnumeqmin = jkmax+4
-
-         DO ji = kideb , kiut
-            zindtbis(ji,numeqmin(ji)) =  zindterm(ji,numeqmin(ji))
+         minnumeqmin = nlay_i+5
+
+         DO ji = kideb , kiut
+            zswitbis(ji,numeqmin(ji)) =  zswiterm(ji,numeqmin(ji))
             zdiagbis(ji,numeqmin(ji)) =  ztrid(ji,numeqmin(ji),2)
             minnumeqmin               =  MIN(numeqmin(ji),minnumeqmin)
@@ -629 +632 @@
          END DO
 
-         DO layer = minnumeqmin+1, maxnumeqmax
-            DO ji = kideb , kiut
-               numeq               =  min(max(numeqmin(ji)+1,layer),numeqmax(ji))
+         DO jk = minnumeqmin+1, maxnumeqmax
+            DO ji = kideb , kiut
+               numeq               =  min(max(numeqmin(ji)+1,jk),numeqmax(ji))
                zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* &
                   ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1)
-               zindtbis(ji,numeq)  =  zindterm(ji,numeq) - ztrid(ji,numeq,1)* &
-                  zindtbis(ji,numeq-1)/zdiagbis(ji,numeq-1)
+               zswitbis(ji,numeq)  =  zswiterm(ji,numeq) - ztrid(ji,numeq,1)* &
+                  zswitbis(ji,numeq-1)/zdiagbis(ji,numeq-1)
             END DO
          END DO
@@ -641 +644 @@
          DO ji = kideb , kiut
             ! ice temperatures
-            t_i_b(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji))
+            t_i_1d(ji,nlay_i)    =  zswitbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji))
          END DO
 
          DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1
             DO ji = kideb , kiut
-               layer    =  numeq - nlay_s - 1
-               t_i_b(ji,layer)  =  (zindtbis(ji,numeq) - ztrid(ji,numeq,3)* &
-                  t_i_b(ji,layer+1))/zdiagbis(ji,numeq)
+               jk    =  numeq - nlay_s - 1
+               t_i_1d(ji,jk)  =  (zswitbis(ji,numeq) - ztrid(ji,numeq,3)* &
+                  t_i_1d(ji,jk+1))/zdiagbis(ji,numeq)
             END DO
          END DO
@@ -654 +657 @@
          DO ji = kideb , kiut
             ! snow temperatures      
-            IF (ht_s_b(ji).GT.0._wp) &
-               t_s_b(ji,nlay_s)     =  (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) &
-               *  t_i_b(ji,1))/zdiagbis(ji,nlay_s+1) &
-               *        MAX(0.0,SIGN(1.0,ht_s_b(ji))) 
+            IF (ht_s_1d(ji).GT.0._wp) &
+               t_s_1d(ji,nlay_s)     =  (zswitbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) &
+               *  t_i_1d(ji,1))/zdiagbis(ji,nlay_s+1) &
+               *        MAX(0.0,SIGN(1.0,ht_s_1d(ji))) 
 
             ! surface temperature
-            isnow(ji)     = NINT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_b(ji) )  )  )
-            ztsuoldit(ji) = t_su_b(ji)
-            IF( t_su_b(ji) < ztfs(ji) ) &
-               t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_b(ji,1)   &
-               &          + REAL( 1 - isnow(ji) )*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))  
+            isnow(ji)     = NINT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_1d(ji) )  )  )
+            ztsubit(ji) = t_su_1d(ji)
+            IF( t_su_1d(ji) < ztfs(ji) ) &
+               t_su_1d(ji) = ( zswitbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_1d(ji,1)   &
+               &          + REAL( 1 - isnow(ji) )*t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))  
          END DO
          !
@@ -674 +677 @@
          ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd
          DO ji = kideb , kiut
-            t_su_b(ji) =  MAX(  MIN( t_su_b(ji) , ztfs(ji) ) , 190._wp  )
-            zerrit(ji) =  ABS( t_su_b(ji) - ztsuoldit(ji) )     
-         END DO
-
-         DO layer  =  1, nlay_s
-            DO ji = kideb , kiut
-               t_s_b(ji,layer) = MAX(  MIN( t_s_b(ji,layer), rtt ), 190._wp  )
-               zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_b(ji,layer) - ztstemp(ji,layer)))
-            END DO
-         END DO
-
-         DO layer  =  1, nlay_i
-            DO ji = kideb , kiut
-               ztmelt_i        = -tmut * s_i_b(ji,layer) + rtt 
-               t_i_b(ji,layer) =  MAX(MIN(t_i_b(ji,layer),ztmelt_i), 190._wp)
-               zerrit(ji)      =  MAX(zerrit(ji),ABS(t_i_b(ji,layer) - ztitemp(ji,layer)))
+            t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , ztfs(ji) ) , 190._wp  )
+            zerrit(ji) =  ABS( t_su_1d(ji) - ztsubit(ji) )     
+         END DO
+
+         DO jk  =  1, nlay_s
+            DO ji = kideb , kiut
+               t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rtt ), 190._wp  )
+               zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_1d(ji,jk) - ztstemp(ji,jk)))
+            END DO
+         END DO
+
+         DO jk  =  1, nlay_i
+            DO ji = kideb , kiut
+               ztmelt_i        = -tmut * s_i_1d(ji,jk) + rtt 
+               t_i_1d(ji,jk) =  MAX(MIN(t_i_1d(ji,jk),ztmelt_i), 190._wp)
+               zerrit(ji)      =  MAX(zerrit(ji),ABS(t_i_1d(ji,jk) - ztitemp(ji,jk)))
             END DO
          END DO
@@ -714 +717 @@
       DO ji = kideb, kiut
          ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux) 
-         IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) )
+         IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) )
          !                                ! surface ice conduction flux
-         isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) )  )
-         fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji))   &
-            &               - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_b(ji,1) - t_su_b(ji))
+         isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) )  )
+         fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   &
+            &               - REAL( 1 - 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_b(ji) - t_i_b(ji,nlay_i)) )
+         fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) )
       END DO
 
@@ -727 +730 @@
       !-----------------------------------------
       DO ji = kideb, kiut
-         IF( t_su_b(ji) < rtt ) THEN  ! case T_su < 0degC
-            hfx_dif_1d(ji) = hfx_dif_1d(ji) + ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji)
+         IF( t_su_1d(ji) < rtt ) THEN  ! case T_su < 0degC
+            hfx_dif_1d(ji) = hfx_dif_1d(ji)  +   &
+               &            ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
          ELSE                         ! case T_su = 0degC
-            hfx_dif_1d(ji) = hfx_dif_1d(ji) + ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_b(ji)
+            hfx_dif_1d(ji) = hfx_dif_1d(ji) +    &
+               &             ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji)
          ENDIF
       END DO
@@ -737 +742 @@
       CALL lim_thd_enmelt( kideb, kiut )
 
-      ! --- diag error on heat diffusion - PART 2 --- !
+      ! --- diag conservation imbalance on heat diffusion - PART 2 --- !
       DO ji = kideb, kiut
-         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) - zradtr_i(ji,nlay_i) - 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 --- !
+         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  &
+            &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) )
+         zhfx_err(ji)   = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 
+         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji)
+      END DO 
+
+      ! diagnose external surface (forced case) or bottom (forced case) from heat conservation
+      IF( .NOT. lk_cpl ) THEN   ! --- forced case: qns_ice and fc_su are diagnosed
+         !
+         DO ji = kideb, kiut
+            qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji)
+            fc_su     (ji) = fc_su(ji)      - zhfx_err(ji)
+         END DO
+         !
+      ELSE                      ! --- coupled case: ocean turbulent heat flux is diagnosed
+         !
+         DO ji = kideb, kiut
+            fhtur_1d  (ji) = fhtur_1d(ji)   - zhfx_err(ji)
+         END DO
+         !
+      ENDIF
+
+      ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2)
+      DO ji = kideb, kiut
          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) )
+         hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_1d(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) )
       END DO
    
       !
       CALL wrk_dealloc( jpij, numeqmin, numeqmax, isnow )
-      CALL wrk_dealloc( jpij, ztfs, ztsuold, ztsuoldit, zh_i, zh_s, zfsw )
+      CALL wrk_dealloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw )
       CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu )
-      CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztiold, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )
-      CALL wrk_dealloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsold, zeta_s, ztstemp, z_s, kjstart = 0 )
-      CALL wrk_dealloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis )
-      CALL wrk_dealloc( jpij, jkmax+2, 3, ztrid )
-      CALL wrk_dealloc( jpij, zdq, zq_ini )
+      CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i,   &
+         &              ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 )
+      CALL wrk_dealloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 )
+      CALL wrk_dealloc( jpij, nlay_i+3, zswiterm, zswitbis, zdiagbis )
+      CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid )
+      CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err )
 
    END SUBROUTINE lim_thd_dif
@@ -774 +796 @@
       !
       INTEGER  ::   ji, jk   ! dummy loop indices
-      REAL(wp) ::   ztmelts, zindb  ! local scalar 
+      REAL(wp) ::   ztmelts  ! 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 ) )   &
+            ztmelts      = - tmut  * s_i_1d(ji,jk) + rtt 
+            rswitch      = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rtt) - epsi10 ) )
+            q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                                             &
+               &                   + lfus * ( 1.0 - rswitch * ( ztmelts-rtt ) / MIN( t_i_1d(ji,jk)-rtt, -epsi10 ) )   &
                &                   - rcp  *                 ( ztmelts-rtt )  ) 
          END DO
@@ -788 +810 @@
       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 )
+            q_s_1d(ji,jk) = rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus )
          END DO
       END DO

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

@@ -38 +38 @@
    PUBLIC   lim_thd_ent         ! called by limthd and limthd_lac
 
-   REAL(wp) :: epsi20 = 1.e-20   ! constant values
-   REAL(wp) :: epsi10 = 1.e-10   ! constant values
-
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
@@ -79 +76 @@
       INTEGER  :: ji         !  dummy loop indices
       INTEGER  :: jk0, jk1   !  old/new layer indices
-      REAL(wp) :: zswitch
       !
       REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces
@@ -137 +133 @@
       DO jk1 = 1, nlay_i
          DO ji = kideb, kiut
-            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 )
+            rswitch      = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi10 ) ) 
+            qnew(ji,jk1) = rswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi10 )
          ENDDO
       ENDDO
@@ -146 +142 @@
       ! 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 *  &
+         hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  &
             &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( qh_i_old(ji,0:nlay_i+1) ) ) 
       END DO

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

@@ -29 +29 @@
    USE lib_mpp        ! MPP library
    USE wrk_nemo       ! work arrays
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
    USE limthd_ent
@@ -36 +37 @@
 
    PUBLIC lim_thd_lac     ! called by lim_thd
-
-   REAL(wp) ::   epsi10 = 1.e-10_wp   !
-   REAL(wp) ::   epsi20 = 1.e-20_wp   !
 
    !!----------------------------------------------------------------------
@@ -71 +69 @@
       !!             - Computation of variation of ice volume and mass
       !!             - Computation of frldb after lateral accretion and 
-      !!               update ht_s_b, ht_i_b and tbif_1d(:,:)      
+      !!               update ht_s_1d, ht_i_1d and tbif_1d(:,:)      
       !!------------------------------------------------------------------------
-      INTEGER ::   ji,jj,jk,jl,jm   ! dummy loop indices
-      INTEGER ::   layer, nbpac     ! local integers 
-      INTEGER ::   ii, ij, iter   !   -       -
-      REAL(wp)  ::   ztmelts, zdv, zfrazb, zweight, zindb, zinda, zde  ! local scalars
+      INTEGER ::   ji,jj,jk,jl      ! dummy loop indices
+      INTEGER ::   nbpac            ! local integers 
+      INTEGER ::   ii, ij, iter     !   -       -
+      REAL(wp)  ::   ztmelts, zdv, zfrazb, zweight, zde                         ! local scalars
       REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new        !   -      -
       REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      -
@@ -89 +87 @@
       REAL(wp) ::   zv_newfra
   
-      INTEGER , POINTER, DIMENSION(:) ::   jcat      ! indexes of categories where new ice grows
+      INTEGER , POINTER, DIMENSION(:) ::   jcat        ! indexes of categories where new ice grows
       REAL(wp), POINTER, DIMENSION(:) ::   zswinew     ! switch for new ice or not
 
@@ -101 +99 @@
       REAL(wp), POINTER, DIMENSION(:) ::   zda_res     ! residual area in case of excessive heat budget
       REAL(wp), POINTER, DIMENSION(:) ::   zat_i_1d    ! total ice fraction    
-      REAL(wp), POINTER, DIMENSION(:) ::   zat_i_lev   ! total ice fraction for level ice only (type 1)   
-      REAL(wp), POINTER, DIMENSION(:) ::   zv_frazb   ! accretion of frazil ice at the ice bottom
+      REAL(wp), POINTER, DIMENSION(:) ::   zv_frazb    ! accretion of frazil ice at the ice bottom
       REAL(wp), POINTER, DIMENSION(:) ::   zvrel_1d    ! relative ice / frazil velocity (1D vector)
 
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_old      ! old volume of ice in category jl
-      REAL(wp), POINTER, DIMENSION(:,:) ::   za_old      ! old area of ice in category jl
-      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d     ! 1-D version of a_i
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d     ! 1-D version of v_i
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_1d    ! 1-D version of oa_i
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d   ! 1-D version of smv_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_b      ! old volume of ice in category jl
+      REAL(wp), POINTER, DIMENSION(:,:) ::   za_b      ! old area of ice in category jl
+      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_1d  ! 1-D version of oa_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i
 
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d   !: 1-D version of e_i
@@ -119 +116 @@
       CALL wrk_alloc( jpij, jcat )   ! integer
       CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
-      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zat_i_lev, zv_frazb, zvrel_1d )
-      CALL wrk_alloc( jpij,jpl, zv_old, za_old, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )
-      CALL wrk_alloc( jpij,jkmax,jpl, ze_i_1d )
+      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
+      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )
+      CALL wrk_alloc( jpij,nlay_i+1,jpl, ze_i_1d )
       CALL wrk_alloc( jpi,jpj, zvrel )
 
@@ -132 +129 @@
                DO ji = 1, jpi
                   !Energy of melting q(S,T) [J.m-3]
-                  zindb = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes
-                  e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i )
+                  rswitch          = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes
+                  e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) &
+                      &   / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i, wp )
                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac
                END DO
@@ -171 +169 @@
          zgamafr = 0.03
 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
+         DO jj = 2, jpj
+            DO ji = 2, jpi
                IF ( qlead(ji,jj) < 0._wp ) THEN
                   !-------------
@@ -189 +186 @@
                   ! Frazil ice velocity
                   !---------------------
-                  zindb = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) )
-                  zvfrx = zindb * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 )
-                  zvfry = zindb * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 )
+                  rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) )
+                  zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 )
+                  zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 )
 
                   !-------------------
@@ -197 +194 @@
                   !-------------------
                   ! C-grid ice velocity
-                  zindb = MAX(  0._wp, SIGN( 1._wp , at_i(ji,jj) )  )
-                  zvgx  = zindb * (  u_ice(ji-1,jj  ) * tmu(ji-1,jj  )    &
-                     &             + u_ice(ji,jj    ) * tmu(ji  ,jj  )  ) * 0.5_wp
-                  zvgy  = zindb * (  v_ice(ji  ,jj-1) * tmv(ji  ,jj-1)    &
-                     &             + v_ice(ji,jj    ) * tmv(ji  ,jj  )  ) * 0.5_wp
+                  rswitch = MAX(  0._wp, SIGN( 1._wp , at_i(ji,jj) )  )
+                  zvgx    = rswitch * ( u_ice(ji-1,jj  ) * tmu(ji-1,jj  )  + u_ice(ji,jj) * tmu(ji,jj) ) * 0.5_wp
+                  zvgy    = rswitch * ( v_ice(ji  ,jj-1) * tmv(ji  ,jj-1)  + v_ice(ji,jj) * tmv(ji,jj) ) * 0.5_wp
 
                   !-----------------------------------
@@ -243 +238 @@
             END DO ! loop on ji ends
          END DO ! loop on jj ends
+      ! 
+      CALL lbc_lnk( zvrel(:,:), 'T', 1. )
+      CALL lbc_lnk( hicol(:,:), 'T', 1. )
 
       ENDIF ! End of computation of frazil ice collection thickness
@@ -255 +253 @@
       ! This occurs if open water energy budget is negative
       nbpac = 0
+      npac(:) = 0
+      !
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -298 +298 @@
 
          CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, t_bo_b    (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, t_bo_1d   (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) )
          CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw, jpi, jpj, npac(1:nbpac) )
          CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw, jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw, jpi, jpj, npac(1:nbpac) )
-         CALL tab_2d_1d( nbpac, hicol_b   (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, hicol_1d  (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) )
          CALL tab_2d_1d( nbpac, zvrel_1d  (1:nbpac)     , zvrel  , jpi, jpj, npac(1:nbpac) )
 
@@ -315 +314 @@
          ! Keep old ice areas and volume in memory
          !-----------------------------------------
-         zv_old(:,:) = zv_i_1d(:,:) 
-         za_old(:,:) = za_i_1d(:,:)
-
+         zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:) 
+         za_b(1:nbpac,:) = za_i_1d(1:nbpac,:)
          !----------------------
          ! Thickness of new ice
@@ -324 +322 @@
             zh_newice(ji) = hiccrit
          END DO
-         IF( fraz_swi == 1 ) zh_newice(:) = hicol_b(:)
+         IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_1d(1:nbpac)
 
          !----------------------
@@ -331 +329 @@
          SELECT CASE ( num_sal )
          CASE ( 1 )                    ! Sice = constant 
-            zs_newice(:) = bulk_sal
+            zs_newice(1:nbpac) = bulk_sal
          CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)]
             DO ji = 1, nbpac
@@ -339 +337 @@
             END DO
          CASE ( 3 )                    ! Sice = F(z) [multiyear ice]
-            zs_newice(:) =   2.3
+            zs_newice(1:nbpac) =   2.3
          END SELECT
 
@@ -348 +346 @@
          DO ji = 1, nbpac
             ztmelts       = - tmut * zs_newice(ji) + rtt                  ! Melting point (K)
-            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_b(ji) )                             &
-               &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_b(ji) - rtt, -epsi10 ) )   &
+            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_1d(ji) )                             &
+               &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_1d(ji) - rtt, -epsi10 ) )   &
                &                       - rcp  *         ( ztmelts - rtt )  )
          END DO ! ji
@@ -367 +365 @@
             zEi           = - ze_newice(ji) / rhoic                ! specific enthalpy of forming ice [J/kg]
 
-            zEw           = rcp * ( t_bo_b(ji) - rt0 )             ! specific enthalpy of seawater at t_bo_b [J/kg]
+            zEw           = rcp * ( t_bo_1d(ji) - rt0 )             ! specific enthalpy of seawater at t_bo_1d [J/kg]
                                                                    ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied) 
                                                                    
@@ -388 +386 @@
 
             ! A fraction zfrazb of frazil ice is accreted at the ice bottom
-            zinda         = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) )
-            zfrazb        = zinda * ( TANH ( Cfrazb * ( zvrel_1d(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb
+            rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) )
+            zfrazb        = rswitch * ( TANH ( Cfrazb * ( zvrel_1d(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb
             zv_frazb(ji)  =         zfrazb   * zv_newice(ji)
             zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji)
@@ -438 +436 @@
          DO ji = 1, nbpac
             jl = jcat(ji)                                                    ! categroy in which new ice is put
-            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) ) )   ! 0 if old ice
+            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_b(ji,jl) ) )   ! 0 if old ice
          END DO
 
@@ -444 +442 @@
             DO ji = 1, nbpac
                jl = jcat(ji)
-               zinda = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) )
+               rswitch = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) )
                ze_i_1d(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji) +                                                      &
-                  &        ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_old(ji,jl) )  &
-                  &        * zinda / MAX( zv_i_1d(ji,jl), epsi20 )
+                  &        ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_b(ji,jl) )  &
+                  &        * rswitch / MAX( zv_i_1d(ji,jl), epsi20 )
             END DO
          END DO
@@ -468 +466 @@
             ! new volumes including lateral/bottom accretion + residual
             DO ji = 1, nbpac
-               zinda          = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) )
-               zv_newfra      = zinda * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_1d(ji,jl) / MAX( zat_i_1d(ji) , epsi20 )
-               za_i_1d(ji,jl) = zinda * za_i_1d(ji,jl)               
+               rswitch        = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) )
+               zv_newfra      = rswitch * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_1d(ji,jl) / MAX( zat_i_1d(ji) , epsi20 )
+               za_i_1d(ji,jl) = rswitch * za_i_1d(ji,jl)               
                zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra
-
                ! for remapping
                h_i_old (ji,nlay_i+1) = zv_newfra
                qh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra
             ENDDO
-
             ! --- Ice enthalpy remapping --- !
-            IF( zv_newfra > 0._wp ) THEN
-               CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) ) 
-            ENDIF
-
+            CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) ) 
          ENDDO
 
@@ -490 +483 @@
          DO jl = 1, jpl
             DO ji = 1, nbpac
-               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_1d(ji,jl) + epsi20 ) )  ! 0 if no ice and 1 if yes
-               zoa_i_1d(ji,jl)  = za_old(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * zindb   
+               rswitch          = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_1d(ji,jl) + epsi20 ) )  ! 0 if no ice and 1 if yes
+               zoa_i_1d(ji,jl)  = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * rswitch   
             END DO 
          END DO   
@@ -500 +493 @@
          DO jl = 1, jpl
             DO ji = 1, nbpac
-               zdv   = zv_i_1d(ji,jl) - zv_old(ji,jl)
+               zdv   = zv_i_1d(ji,jl) - zv_b(ji,jl)
                zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji)
             END DO
@@ -519 +512 @@
          CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj )
          CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj )
-         CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj )
 
          CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj )
@@ -534 +526 @@
                DO ji = 1, jpi
                   ! heat content in Joules
-                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ) * unit_fac ) 
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ,wp ) * unit_fac ) 
                END DO
             END DO
@@ -543 +535 @@
       CALL wrk_dealloc( jpij, jcat )   ! integer
       CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice )
-      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zat_i_lev, zv_frazb, zvrel_1d )
-      CALL wrk_dealloc( jpij,jpl, zv_old, za_old, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )
-      CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_1d )
+      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d )
+      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d )
+      CALL wrk_dealloc( jpij,nlay_i+1,jpl, ze_i_1d )
       CALL wrk_dealloc( jpi,jpj, zvrel )
       !

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

@@ -60 +60 @@
       !---------------------------------------------------------
       DO ji = kideb, kiut
-         sm_i_b(ji) = sm_i_b(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji)
+         sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji)
       END DO
  
@@ -66 +66 @@
       ! 1) Constant salinity, constant in time                                       |
       !------------------------------------------------------------------------------|
-!!gm comment: if num_sal = 1 s_i_new, s_i_b and sm_i_b can be set to bulk_sal one for all in the initialisation phase !!
+!!gm comment: if num_sal = 1 s_i_new, s_i_1d and sm_i_1d can be set to bulk_sal one for all in the initialisation phase !!
 !!gm           ===>>>   simplification of almost all test on num_sal value
       IF(  num_sal == 1  ) THEN
-            s_i_b  (kideb:kiut,1:nlay_i) =  bulk_sal
-            sm_i_b (kideb:kiut)          =  bulk_sal 
+            s_i_1d (kideb:kiut,1:nlay_i) =  bulk_sal
+            sm_i_1d(kideb:kiut)          =  bulk_sal 
             s_i_new(kideb:kiut)          =  bulk_sal
       ENDIF
@@ -83 +83 @@
             ! Switches 
             !----------
-            iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_b(ji) - rtt )        )    ! =1 if summer 
-            igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_b(ji) - t_su_b(ji) ) )    ! =1 if t_su < t_bo
+            iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rtt )        )     ! =1 if summer 
+            igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )    ! =1 if t_su < t_bo
 
             !---------------------
@@ -90 +90 @@
             !---------------------
             ! drainage by gravity drainage
-            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice 
+            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - sal_G , 0._wp ) / time_G * rdt_ice 
             ! drainage by flushing  
-            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice
+            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_1d(ji) - sal_F , 0._wp ) / time_F * rdt_ice
 
             !-----------------
@@ -99 +99 @@
             ! only drainage terms ( gravity drainage and flushing )
             ! snow ice / bottom sources are added in lim_thd_ent to conserve energy
-            sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji)
+            sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji)
 
             !----------------------------
             ! Salt flux - brine drainage
             !----------------------------
-            sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_b(ji) * ht_i_b(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice
+            sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice
 
          END DO

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

@@ -37 +37 @@
    PUBLIC   lim_trp    ! called by ice_step
 
-   REAL(wp)  ::   epsi10 = 1.e-10_wp  
-   REAL(wp)  ::   epsi20 = 1.e-20_wp  
-
    !! * Substitution
 #  include "vectopt_loop_substitute.h90"
@@ -63 +60 @@
       INTEGER, INTENT(in) ::   kt   ! number of iteration
       !
-      INTEGER  ::   ji, jj, jk, jl, layer   ! dummy loop indices
+      INTEGER  ::   ji, jj, jk, jl, jn      ! dummy loop indices
       INTEGER  ::   initad                  ! number of sub-timestep for the advection
-      INTEGER  ::   ierr                    ! error status
-      REAL(wp) ::   zindb  , zindsn , zindic, zindh, zinda      ! local scalar
-      REAL(wp) ::   zcfl , zusnit                 !   -      -
-      REAL(wp) ::   zsal   , zage          !   -      -
+      REAL(wp) ::   zcfl , zusnit           !   -      -
       !
       REAL(wp), POINTER, DIMENSION(:,:)      ::   zui_u, zvi_v, zsm, zs0at, zs0ow
       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi
       REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e
-      ! mass and salt flux (clem)
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold   ! old ice volume...
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaiold, zhimax   ! old ice concentration and thickness
-      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeiold, zesold   ! old enthalpies
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zviold, zvsold   ! old ice volume...
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zaiold, zhimax   ! old ice concentration and thickness
+      REAL(wp), POINTER, DIMENSION(:,:)      ::   zeiold, zesold   ! old enthalpies
       REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei
       !
@@ -85 +78 @@
       CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold )
       CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi )
-      CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e )
+      CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, zs0e )
 
       CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold )   ! clem
@@ -167 +160 @@
 
          IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==!
-            DO jk = 1,initad
+            DO jn = 1,initad
                CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area
                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
@@ -197 +190 @@
                   CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &
                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  DO layer = 1, nlay_i                                                           !--- ice heat contents ---
-                     CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   & 
-                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   &
-                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) )
-                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   & 
-                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   &
-                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) )
+                  DO jk = 1, nlay_i                                                           !--- ice heat contents ---
+                     CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
+                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
                   END DO
                END DO
             END DO
          ELSE
-            DO jk = 1, initad
+            DO jn = 1, initad
                CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area
                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
@@ -239 +232 @@
                   CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &
                      &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
-                  DO layer = 1, nlay_i                                                           !--- ice heat contents ---
-                     CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   & 
-                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   &
-                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) )
-                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   & 
-                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   &
-                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) )
+                  DO jk = 1, nlay_i                                                           !--- ice heat contents ---
+                     CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
+                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   & 
+                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   &
+                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) )
                   END DO
                END DO
@@ -341 +334 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zindb= MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) )
+                  rswitch = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) )
 
                   zvi  = zs0ice(ji,jj,jl)
@@ -349 +342 @@
                   !
                   ! Remove very small areas
-                  v_s(ji,jj,jl)   = zindb * zs0sn (ji,jj,jl) 
-                  v_i(ji,jj,jl)   = zindb * zs0ice(ji,jj,jl)
-                  a_i(ji,jj,jl)   = zindb * zs0a  (ji,jj,jl)
-                  e_s(ji,jj,1,jl) = zindb * zs0c0 (ji,jj,jl)      
+                  v_s(ji,jj,jl)   = rswitch * zs0sn (ji,jj,jl) 
+                  v_i(ji,jj,jl)   = rswitch * zs0ice(ji,jj,jl)
+                  a_i(ji,jj,jl)   = rswitch * zs0a  (ji,jj,jl)
+                  e_s(ji,jj,1,jl) = rswitch * zs0c0 (ji,jj,jl)      
                   ! Ice salinity and age
                   IF(  num_sal == 2  ) THEN
                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) )
                   ENDIF
-                  oa_i(ji,jj,jl) = MAX( zindb * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl)
+                  oa_i(ji,jj,jl) = MAX( rswitch * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl)
 
                  ! Update fluxes
@@ -372 +365 @@
                DO jj = 1, jpj
                   DO ji = 1, jpi
-                     zindb            = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) )
+                     rswitch          = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) )
                      zei              = zs0e(ji,jj,jk,jl)      
-                     e_i(ji,jj,jk,jl) = zindb * MAX( 0._wp, zs0e(ji,jj,jk,jl) )
+                     e_i(ji,jj,jk,jl) = rswitch * MAX( 0._wp, zs0e(ji,jj,jk,jl) )
                      ! Update fluxes
                      hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
@@ -393 +386 @@
                      zsmv = smv_i(ji,jj,jl)
                      zes  = e_s  (ji,jj,1,jl)
-                     zei  = SUM( e_i(ji,jj,:,jl) )
+                     zei  = SUM( e_i(ji,jj,1:nlay_i,jl) )
                      zdv  = v_i(ji,jj,jl) - zviold(ji,jj,jl)   
                      !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)   
                      
-                     zindh = 1._wp
+                     rswitch = 1._wp
                      IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. SUM( zaiold(ji,jj,1:jpl) ) < 0.80 ) .OR. &
                         & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN                                          
                         ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) )
-                        zindh   =  MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) )
-                        a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 )
+                        rswitch        = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) )
+                        a_i(ji,jj,jl)  = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 )
                      ELSE
                         ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) )
-                        zindh   =  MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) )
-                        a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 )
+                        rswitch        = MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) )
+                        a_i(ji,jj,jl)  = rswitch * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 )
                      ENDIF
 
-                     ! small correction due to *zindh for a_i
-                     v_i  (ji,jj,jl) = zindh * v_i  (ji,jj,jl)
-                     v_s  (ji,jj,jl) = zindh * v_s  (ji,jj,jl)
-                     smv_i(ji,jj,jl) = zindh * smv_i(ji,jj,jl)
-                     e_s(ji,jj,1,jl) = zindh * e_s(ji,jj,1,jl)
-                     e_i(ji,jj,:,jl) = zindh * e_i(ji,jj,:,jl)
+                     ! small correction due to *rswitch for a_i
+                     v_i  (ji,jj,jl) = rswitch * v_i  (ji,jj,jl)
+                     v_s  (ji,jj,jl) = rswitch * v_s  (ji,jj,jl)
+                     smv_i(ji,jj,jl) = rswitch * smv_i(ji,jj,jl)
+                     e_s(ji,jj,1,jl) = rswitch * e_s(ji,jj,1,jl)
+                     e_i(ji,jj,1:nlay_i,jl) = rswitch * e_i(ji,jj,1:nlay_i,jl)
 
                      ! Update mass fluxes
@@ -421 +414 @@
                      sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice 
                      hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,:,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
-
+                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,1:nlay_i,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
                   ENDIF
-
-                  diag_trp_vi(ji,jj) = diag_trp_vi(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice
-                  diag_trp_vs(ji,jj) = diag_trp_vs(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * r1_rdtice
-
                END DO
             END DO
@@ -438 +426 @@
                diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice
                diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice
-            END DO
-         END DO
-
-         ! --- agglomerate variables (clem) -----------------
+
+               diag_trp_vi(ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice
+               diag_trp_vs(ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice
+            END DO
+         END DO
+
+         ! --- agglomerate variables -----------------
          vt_i (:,:) = 0._wp
          vt_s (:,:) = 0._wp
@@ -462 +453 @@
             DO ji = 1, jpi
                ! open water = 1 if at_i=0
-               zindb        = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )
-               ato_i(ji,jj) = zindb + (1._wp - zindb ) * zs0ow(ji,jj)
+               rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )
+               ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * zs0ow(ji,jj)
             END DO
          END DO      
@@ -506 +497 @@
       CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold )
       CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi )
-      CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e )
+      CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, zs0e )
 
       CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax )   ! clem

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

@@ -50 +50 @@
    PUBLIC   lim_update1   ! routine called by ice_step
 
-      REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       -
-         
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
@@ -69 +67 @@
       !!                
       !!---------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk, jl, jm    ! dummy loop indices
-      INTEGER  ::   jbnd1, jbnd2
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
       INTEGER  ::   i_ice_switch
       REAL(wp) ::   zsal
@@ -93 +90 @@
       ! Rebin categories with thickness out of bounds
       !----------------------------------------------------
-      DO jm = 1, jpm
-         jbnd1 = ice_cat_bounds(jm,1)
-         jbnd2 = ice_cat_bounds(jm,2)
-         IF (ice_ncat_types(jm) .GT. 1 )   CALL lim_itd_th_reb(jbnd1, jbnd2, jm)
-      END DO
+      IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl)
 
       at_i(:,:) = 0._wp
@@ -126 +119 @@
       ! Final thickness distribution rebinning
       ! --------------------------------------
-      DO jm = 1, jpm
-         jbnd1 = ice_cat_bounds(jm,1)
-         jbnd2 = ice_cat_bounds(jm,2)
-         IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm)
-         IF (ice_ncat_types(jm) .EQ. 1 ) THEN
-         ENDIF
-      END DO
+      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
 
       !-----------------
@@ -161 +148 @@
       ! Diagnostics
       ! -------------------------------------------------
-      d_u_ice_dyn(:,:)     = u_ice(:,:)     - old_u_ice(:,:)
-      d_v_ice_dyn(:,:)     = v_ice(:,:)     - old_v_ice(:,:)
-      d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - old_a_i  (:,:,:)
-      d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - old_v_s  (:,:,:)  
-      d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - old_v_i  (:,:,:)   
-      d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - old_e_s  (:,:,:,:)  
-      d_e_i_trp  (:,:,1:nlay_i,:) = e_i  (:,:,1:nlay_i,:) - old_e_i(:,:,1:nlay_i,:)
-      d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - old_oa_i (:,:,:)
+      d_u_ice_dyn(:,:)     = u_ice(:,:)     - u_ice_b(:,:)
+      d_v_ice_dyn(:,:)     = v_ice(:,:)     - v_ice_b(:,:)
+      d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - a_i_b  (:,:,:)
+      d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - v_s_b  (:,:,:)  
+      d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - v_i_b  (:,:,:)   
+      d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - e_s_b  (:,:,:,:)  
+      d_e_i_trp  (:,:,1:nlay_i,:) = e_i  (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:)
+      d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - oa_i_b (:,:,:)
       d_smv_i_trp(:,:,:)   = 0._wp
-      IF(  num_sal == 2  ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:)
+      IF(  num_sal == 2  ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:)
 
       ! conservation test
@@ -186 +173 @@
          CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update1  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :')
          CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update1  : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :')
-         CALL prt_ctl(tab2d_1=old_u_ice  , clinfo1=' lim_update1  : old_u_ice   :', tab2d_2=old_v_ice  , clinfo2=' old_v_ice   :')
+         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :')
 
          DO jl = 1, jpl
@@ -199 +186 @@
             CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update1  : o_i         : ')
             CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ')
-            CALL prt_ctl(tab2d_1=old_a_i    (:,:,jl)        , clinfo1= ' lim_update1  : old_a_i     : ')
+            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : a_i_b       : ')
             CALL prt_ctl(tab2d_1=d_a_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_a_i_trp   : ')
             CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ')
-            CALL prt_ctl(tab2d_1=old_v_i    (:,:,jl)        , clinfo1= ' lim_update1  : old_v_i     : ')
+            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_i_b       : ')
             CALL prt_ctl(tab2d_1=d_v_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_i_trp   : ')
             CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ')
-            CALL prt_ctl(tab2d_1=old_v_s    (:,:,jl)        , clinfo1= ' lim_update1  : old_v_s     : ')
+            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_s_b       : ')
             CALL prt_ctl(tab2d_1=d_v_s_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_s_trp   : ')
             CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1        : ')
-            CALL prt_ctl(tab2d_1=old_e_i    (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : old_e_i1    : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1_b      : ')
             CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : de_i1_trp   : ')
             CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2        : ')
-            CALL prt_ctl(tab2d_1=old_e_i    (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : old_e_i2    : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2_b      : ')
             CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : de_i2_trp   : ')
             CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ')
-            CALL prt_ctl(tab2d_1=old_e_s    (:,:,1,jl)      , clinfo1= ' lim_update1  : old_e_snow  : ')
+            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow_b    : ')
             CALL prt_ctl(tab2d_1=d_e_s_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : d_e_s_trp   : ')
             CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ')
-            CALL prt_ctl(tab2d_1=old_smv_i  (:,:,jl)        , clinfo1= ' lim_update1  : old_smv_i   : ')
+            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update1  : smv_i_b     : ')
             CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl)        , clinfo1= ' lim_update1  : d_smv_i_trp : ')
             CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ')
-            CALL prt_ctl(tab2d_1=old_oa_i   (:,:,jl)        , clinfo1= ' lim_update1  : old_oa_i    : ')
+            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update1  : oa_i_b      : ')
             CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl)        , clinfo1= ' lim_update1  : d_oa_i_trp  : ')
 

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

@@ -47 +47 @@
    PUBLIC   lim_update2   ! routine called by ice_step
 
-   REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       -
-   REAL(wp)  ::   epsi20 = 1.e-20_wp   
-      
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
@@ -67 +64 @@
       !!
       !!---------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk, jl, jm    ! dummy loop indices
-      INTEGER  ::   jbnd1, jbnd2
+      INTEGER  ::   ji, jj, jk, jl    ! dummy loop indices
       INTEGER  ::   i_ice_switch
       REAL(wp) ::   zh, zsal
@@ -89 +85 @@
       ! Rebin categories with thickness out of bounds
       !----------------------------------------------------
-      DO jm = 1, jpm
-         jbnd1 = ice_cat_bounds(jm,1)
-         jbnd2 = ice_cat_bounds(jm,2)
-         IF (ice_ncat_types(jm) .GT. 1 )   CALL lim_itd_th_reb(jbnd1, jbnd2, jm)
-      END DO
+      IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl)
 
       !----------------------------------------------------------------------
       ! Constrain the thickness of the smallest category above hiclim
       !----------------------------------------------------------------------
-      DO jm = 1, jpm
-         DO jj = 1, jpj 
-            DO ji = 1, jpi
-               jl = ice_cat_bounds(jm,1)
-               IF( v_i(ji,jj,jl) > 0._wp .AND. ht_i(ji,jj,jl) < hiclim ) THEN
-                  zh             = hiclim / ht_i(ji,jj,jl)
-                  ht_s(ji,jj,jl) = ht_s(ji,jj,jl) * zh
-                  ht_i(ji,jj,jl) = ht_i(ji,jj,jl) * zh
-                  a_i (ji,jj,jl) = a_i(ji,jj,jl)  / zh
-               ENDIF
-            END DO !ji
-         END DO !jj
-      END DO !jm
+      DO jj = 1, jpj 
+         DO ji = 1, jpi
+            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < hiclim ) THEN
+               zh             = hiclim / ht_i(ji,jj,1)
+               ht_s(ji,jj,1) = ht_s(ji,jj,1) * zh
+               ht_i(ji,jj,1) = ht_i(ji,jj,1) * zh
+               a_i (ji,jj,1) = a_i(ji,jj,1)  / zh
+            ENDIF
+         END DO
+      END DO
       
       !-----------------------------------------------------
@@ -139 +128 @@
       ! Final thickness distribution rebinning
       ! --------------------------------------
-      DO jm = 1, jpm
-         jbnd1 = ice_cat_bounds(jm,1)
-         jbnd2 = ice_cat_bounds(jm,2)
-         IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm)
-         IF (ice_ncat_types(jm) .EQ. 1 ) THEN
-         ENDIF
-      END DO
+      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl )
 
       !-----------------
@@ -196 +179 @@
       ! Diagnostics
       ! -------------------------------------------------
-      d_a_i_thd(:,:,:)   = a_i(:,:,:)   - old_a_i(:,:,:) 
-      d_v_s_thd(:,:,:)   = v_s(:,:,:)   - old_v_s(:,:,:)
-      d_v_i_thd(:,:,:)   = v_i(:,:,:)   - old_v_i(:,:,:)  
-      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:) 
-      d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - old_e_i(:,:,1:nlay_i,:)
-      !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - old_oa_i (:,:,:)
+      d_a_i_thd(:,:,:)   = a_i(:,:,:)   - a_i_b(:,:,:) 
+      d_v_s_thd(:,:,:)   = v_s(:,:,:)   - v_s_b(:,:,:)
+      d_v_i_thd(:,:,:)   = v_i(:,:,:)   - v_i_b(:,:,:)  
+      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:) 
+      d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:)
+      !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - oa_i_b (:,:,:)
       d_smv_i_thd(:,:,:) = 0._wp
-      IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:)
+      IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:)
       ! diag only (clem)
       dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday
@@ -211 +194 @@
          DO ji = 1, jpi            
             diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) +  & 
-               &                     SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) ) ) * unit_fac * r1_rdtice / area(ji,jj)   
+               &                     SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) )    &
+               &                   ) * unit_fac * r1_rdtice / area(ji,jj)   
          END DO
       END DO
@@ -228 +212 @@
          CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update2  : strength    :')
          CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update2  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :')
-         CALL prt_ctl(tab2d_1=old_u_ice  , clinfo1=' lim_update2  : old_u_ice   :', tab2d_2=old_v_ice  , clinfo2=' old_v_ice   :')
+         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update2  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :')
 
          DO jl = 1, jpl
@@ -241 +225 @@
             CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update2  : o_i         : ')
             CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update2  : a_i         : ')
-            CALL prt_ctl(tab2d_1=old_a_i    (:,:,jl)        , clinfo1= ' lim_update2  : old_a_i     : ')
+            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : a_i_b       : ')
             CALL prt_ctl(tab2d_1=d_a_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_a_i_thd   : ')
             CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update2  : v_i         : ')
-            CALL prt_ctl(tab2d_1=old_v_i    (:,:,jl)        , clinfo1= ' lim_update2  : old_v_i     : ')
+            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_i_b       : ')
             CALL prt_ctl(tab2d_1=d_v_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_i_thd   : ')
             CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update2  : v_s         : ')
-            CALL prt_ctl(tab2d_1=old_v_s    (:,:,jl)        , clinfo1= ' lim_update2  : old_v_s     : ')
+            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_s_b       : ')
             CALL prt_ctl(tab2d_1=d_v_s_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_s_thd   : ')
             CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1        : ')
-            CALL prt_ctl(tab2d_1=old_e_i    (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : old_e_i1    : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1_b      : ')
             CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : de_i1_thd   : ')
             CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2        : ')
-            CALL prt_ctl(tab2d_1=old_e_i    (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : old_e_i2    : ')
+            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2_b      : ')
             CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : de_i2_thd   : ')
             CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow      : ')
-            CALL prt_ctl(tab2d_1=old_e_s    (:,:,1,jl)      , clinfo1= ' lim_update2  : old_e_snow  : ')
+            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow_b    : ')
             CALL prt_ctl(tab2d_1=d_e_s_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : d_e_s_thd   : ')
             CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update2  : smv_i       : ')
-            CALL prt_ctl(tab2d_1=old_smv_i  (:,:,jl)        , clinfo1= ' lim_update2  : old_smv_i   : ')
+            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update2  : smv_i_b     : ')
             CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl)        , clinfo1= ' lim_update2  : d_smv_i_thd : ')
             CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update2  : oa_i        : ')
-            CALL prt_ctl(tab2d_1=old_oa_i   (:,:,jl)        , clinfo1= ' lim_update2  : old_oa_i    : ')
+            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update2  : oa_i_b      : ')
             CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl)        , clinfo1= ' lim_update2  : d_oa_i_thd  : ')
 

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

@@ -66 +66 @@
    PUBLIC   lim_var_salprof1d    !
 
-   REAL(wp) ::   epsi10 = 1.e-10_wp   !    -       -
-
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
@@ -92 +90 @@
       !
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      REAL(wp) ::   zinda, zindb
       !!------------------------------------------------------------------
 
@@ -111 +108 @@
                at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration
                !
-               zinda = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
-               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda  ! ice thickness
+               rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
+               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch  ! ice thickness
             END DO
          END DO
@@ -132 +129 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zinda = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
-                  zindb = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
                   et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content
-                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * zinda   ! ice salinity
-                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi10 ) * zindb   ! ice age
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 
+                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * rswitch   ! ice salinity
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
+                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi10 ) * rswitch   ! ice age
                END DO
             END DO
@@ -161 +158 @@
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
       REAL(wp) ::   zq_i, zaaa, zbbb, zccc, zdiscrim     ! local scalars
-      REAL(wp) ::   ztmelts, zindb, zq_s, zfac1, zfac2   !   -      -
+      REAL(wp) ::   ztmelts, zq_s, zfac1, zfac2   !   -      -
       !!------------------------------------------------------------------
 
@@ -170 +167 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes
-               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb
-               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb
-               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb
+               rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes
+               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
+               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
+               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
             END DO
          END DO
@@ -182 +179 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes
-                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * zindb
+                  rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes
+                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * rswitch
                END DO
             END DO
@@ -203 +200 @@
                DO ji = 1, jpi
                   !                                                              ! Energy of melting q(S,T) [J.m-3]
-                  zindb   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes
-                  zq_i    = zindb * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp) 
+                  rswitch   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes
+                  zq_i    = rswitch * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp) 
                   zq_i    = zq_i * unit_fac                             !convert units
                   ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt                       ! Ice layer melt temperature
@@ -212 +209 @@
                   zccc       =  lfus * (ztmelts-rtt)
                   zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) )
-                  t_i(ji,jj,jk,jl) = rtt + zindb *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
+                  t_i(ji,jj,jk,jl) = rtt + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
                   t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) )       ! 100-rtt < t_i < rtt
                END DO
@@ -229 +226 @@
                DO ji = 1, jpi
                   !Energy of melting q(S,T) [J.m-3]
-                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes
-                  zq_s  = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp)
+                  rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! rswitch = 0 if no ice and 1 if yes
+                  zq_s  = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp)
                   zq_s  = zq_s * unit_fac                                    ! convert units
                   !
-                  t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 )
+                  t_s(ji,jj,jk,jl) = rtt + rswitch * ( - zfac1 * zq_s + zfac2 )
                   t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) )     ! 100-rtt < t_i < rtt
                END DO
@@ -248 +245 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
-                  tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   &
+                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
+                  tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   &
                      &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  )
                END DO
@@ -295 +292 @@
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop index
       REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac, zsal      ! local scalar
-      REAL(wp) ::   zind0, zind01, zindbal, zargtemp , zs_zero   !   -      -
+      REAL(wp) ::   zswi0, zswi01, zswibal, zargtemp , zs_zero   !   -      -
       REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha   ! 3D pointer
       !!------------------------------------------------------------------
@@ -330 +327 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise
-                  zind0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) ) 
-                  ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 
-                  zind01 = ( 1._wp - zind0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) ) 
-                  ! If 2.sm_i GE sss_m then zindbal = 1
+                  ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise
+                  zswi0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) ) 
+                  ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 
+                  zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) ) 
+                  ! If 2.sm_i GE sss_m then zswibal = 1
                   ! this is to force a constant salinity profile in the Baltic Sea
-                  zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
-                  zalpha(ji,jj,jl) = zind0  + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 )
-                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zindbal )
+                  zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
+                  zalpha(ji,jj,jl) = zswi0  + zswi01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 )
+                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zswibal )
                END DO
             END DO
@@ -390 +387 @@
       !!------------------------------------------------------------------
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      REAL(wp) ::   zindb   !   -      -
       !!------------------------------------------------------------------
 
@@ -399 +395 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
-                  tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   &
+                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
+                  tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   &
                      &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  )
                END DO
@@ -421 +417 @@
       !!------------------------------------------------------------------
       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      REAL(wp) ::   zbvi, zinda, zindb      ! local scalars
+      REAL(wp) ::   zbvi             ! local scalars
       !!------------------------------------------------------------------
       !
@@ -429 +425 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zinda = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) )  )
-                  zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
-                  zbvi  = - zinda * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 )   &
+                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) )  )
+                  zbvi  = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 )   &
                      &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp)
-                  bv_i(ji,jj) = bv_i(ji,jj) + zindb * zbvi  / MAX( vt_i(ji,jj) , epsi10 )
+                  rswitch = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  )
+                  bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi  / MAX( vt_i(ji,jj) , epsi10 )
                END DO
             END DO
@@ -454 +450 @@
       INTEGER  ::   ii, ij  ! local integers
       REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal   ! local scalars
-      REAL(wp) ::   zalpha, zind0, zind01, zindbal, zs_zero              !   -      -
+      REAL(wp) ::   zalpha, zswi0, zswi01, zswibal, zs_zero              !   -      -
       !
       REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s
@@ -464 +460 @@
       ! Vertically constant, constant in time
       !---------------------------------------
-      IF( num_sal == 1 )   s_i_b(:,:) = bulk_sal
+      IF( num_sal == 1 )   s_i_1d(:,:) = bulk_sal
 
       !------------------------------------------------------
@@ -473 +469 @@
          !
          DO ji = kideb, kiut          ! Slope of the linear profile zs_zero
-            z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( epsi10 , ht_i_b(ji) )
+            z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) )
          END DO
 
@@ -488 +484 @@
                ii =  MOD( npb(ji) - 1 , jpi ) + 1
                ij =     ( npb(ji) - 1 ) / jpi + 1
-               ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise
-               zind0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_b(ji) ) ) 
-               ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 
-               zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_b(ji) ) ) 
-               ! if 2.sm_i GE sss_m then zindbal = 1
+               ! zswi0 = 1 if sm_i le s_i_0 and 0 otherwise
+               zswi0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_1d(ji) ) ) 
+               ! zswi01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 
+               zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_1d(ji) ) ) 
+               ! if 2.sm_i GE sss_m then zswibal = 1
                ! this is to force a constant salinity profile in the Baltic Sea
-               zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_b(ji) - sss_m(ii,ij) ) )
+               zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
                !
-               zalpha = (  zind0 + zind01 * ( sm_i_b(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zindbal )
+               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zswibal )
                !
-               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_b(ji) * dummy_fac2
+               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2
                ! weighting the profile
-               s_i_b(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_b(ji)
+               s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji)
             END DO ! ji
          END DO ! jk
@@ -512 +508 @@
       IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
          !
-         sm_i_b(:) = 2.30_wp
+         sm_i_1d(:) = 2.30_wp
          !
 !CDIR NOVERRCHK
@@ -519 +515 @@
             zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  )
             DO ji = kideb, kiut
-               s_i_b(ji,jk) = zsal
+               s_i_1d(ji,jk) = zsal
             END DO
          END DO

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

@@ -35 +35 @@
    PUBLIC lim_wri_state  ! called by dia_wri_state 
 
-   REAL(wp)  ::   epsi06 = 1.e-6_wp
    !!----------------------------------------------------------------------
    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
@@ -59 +58 @@
       INTEGER, INTENT(in) ::   kindic   ! if kindic < 0 there has been an error somewhere
       !
-      INTEGER ::  ji, jj, jk, jl  ! dummy loop indices
-      REAL(wp) ::  zinda, zindb, z1_365
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zoi, zei
-      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d, z2da, z2db, zind    ! 2D workspace
+      INTEGER  ::  ji, jj, jk, jl  ! dummy loop indices
+      REAL(wp) ::  z1_365
+      REAL(wp) ::  ztmp
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, z2da, z2db, zswi    ! 2D workspace
       !!-------------------------------------------------------------------
 
@@ -68 +68 @@
 
       CALL wrk_alloc( jpi, jpj, jpl, zoi, zei )
-      CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zind )
+      CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zswi )
 
       !-----------------------------
@@ -80 +80 @@
       DO jj = 1, jpj          ! presence indicator of ice
          DO ji = 1, jpi
-            zind(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) )
+            zswi(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) )
          END DO
       END DO
@@ -89 +89 @@
          DO jj = 1, jpj 
             DO ji = 1, jpi
-               z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zind(ji,jj)
+               z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj)
             END DO
          END DO
@@ -98 +98 @@
          DO jj = 1, jpj                                            
             DO ji = 1, jpi
-               z2d(ji,jj)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zind(ji,jj)
+               z2d(ji,jj)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj)
             END DO
          END DO
@@ -128 +128 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + zind(ji,jj) * oa_i(ji,jj,jl)
+                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * oa_i(ji,jj,jl)
                END DO
             END DO
@@ -139 +139 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               z2d(ji,jj) = ( tm_i(ji,jj) - rtt ) * zind(ji,jj)
+               z2d(ji,jj) = ( tm_i(ji,jj) - rtt ) * zswi(ji,jj)
             END DO
          END DO
@@ -150 +150 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  z2d(ji,jj) = z2d(ji,jj) + zind(ji,jj) * ( t_su(ji,jj,jl) - rtt ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )
+                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rtt ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )
                END DO
             END DO
@@ -160 +160 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zindb  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) )
-               z2d(ji,jj) = hicol(ji,jj) * zindb
+               rswitch  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) )
+               z2d(ji,jj) = hicol(ji,jj) * rswitch
             END DO
          END DO
@@ -199 +199 @@
       CALL iom_put( "sfx"         , sfx     * rday      )        ! total salt flux
 
-      CALL iom_put( "vfxres"     , wfx_res * rday / rhoic  )        ! daily prod./melting due to limupdate 
-      CALL iom_put( "vfxopw"     , wfx_opw * rday / rhoic  )        ! daily lateral thermodynamic ice production
-      CALL iom_put( "vfxsni"     , wfx_sni * rday / rhoic  )        ! daily snowice ice production
-      CALL iom_put( "vfxbog"     , wfx_bog * rday / rhoic  )       ! daily bottom thermodynamic ice production
-      CALL iom_put( "vfxdyn"     , wfx_dyn * rday / rhoic  )       ! daily dynamic ice production (rid/raft)
-      CALL iom_put( "vfxsum"     , wfx_sum * rday / rhoic  )        ! surface melt 
-      CALL iom_put( "vfxbom"     , wfx_bom * rday / rhoic  )        ! bottom melt 
-      CALL iom_put( "vfxice"     , wfx_ice * rday / rhoic  )        ! total ice growth/melt 
-      CALL iom_put( "vfxsnw"     , wfx_snw * rday / rhoic  )        ! total snw growth/melt 
-      CALL iom_put( "vfxsub"     , wfx_sub * rday / rhoic  )        ! sublimation (snow) 
-      CALL iom_put( "vfxspr"     , wfx_spr * rday / rhoic  )        ! precip (snow) 
+      ztmp = rday / rhoic
+      CALL iom_put( "vfxres"     , wfx_res * ztmp  )             ! daily prod./melting due to limupdate 
+      CALL iom_put( "vfxopw"     , wfx_opw * ztmp  )             ! daily lateral thermodynamic ice production
+      CALL iom_put( "vfxsni"     , wfx_sni * ztmp  )             ! daily snowice ice production
+      CALL iom_put( "vfxbog"     , wfx_bog * ztmp  )             ! daily bottom thermodynamic ice production
+      CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp  )             ! daily dynamic ice production (rid/raft)
+      CALL iom_put( "vfxsum"     , wfx_sum * ztmp  )             ! surface melt 
+      CALL iom_put( "vfxbom"     , wfx_bom * ztmp  )             ! bottom melt 
+      CALL iom_put( "vfxice"     , wfx_ice * ztmp  )             ! total ice growth/melt 
+      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp  )             ! total snw growth/melt 
+      CALL iom_put( "vfxsub"     , wfx_sub * ztmp  )             ! sublimation (snow) 
+      CALL iom_put( "vfxspr"     , wfx_spr * ztmp  )             ! precip (snow) 
 
       CALL iom_put ('hfxthd', hfx_thd(:,:) )   !  
@@ -243 +244 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zinda = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
-                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda
+                  rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
+                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * rswitch
                END DO
             END DO
@@ -258 +259 @@
                DO jj = 1, jpj
                   DO ji = 1, jpi
-                     zinda = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
+                     rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
                      zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* &
                         ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * &
-                        zinda / nlay_i
+                        rswitch / nlay_i
                   END DO
                END DO
@@ -274 +275 @@
       
       CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei )
-      CALL wrk_dealloc( jpi, jpj     , z2d, zind, z2da, z2db )
+      CALL wrk_dealloc( jpi, jpj     , z2d, zswi, z2da, z2db )
 
       IF( nn_timing == 1 )  CALL timing_stop('limwri')
@@ -298 +299 @@
       !!----------------------------------------------------------------------
 
-      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
-      CALL histdef( kid, "iicebopr", "Ice bottom production"   , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iicedypr", "Ice dynamic production"  , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iicelapr", "Ice open water prod"     , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iicesipr", "Snow ice production "    , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iicebome", "Ice bottom melt"         , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iicesume", "Ice surface melt"        , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics"  , ""      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
-      CALL histdef( kid, "iisfxres", "Salt flux from limupdate", ""      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa",   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa",   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2" ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s",   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1",   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
+      CALL histdef( kid, "iicebopr", "Ice bottom production"   , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicedypr", "Ice dynamic production"  , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicelapr", "Ice open water prod"     , "m/s"    ,   &
+      &       jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicesipr", "Snow ice production "    , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicebome", "Ice bottom melt"         , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iicesume", "Ice surface melt"        , "m/s"    ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics"  , ""       ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
+      CALL histdef( kid, "iisfxres", "Salt flux from limupdate", ""       ,   &
+      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
 
       CALL histend( kid, snc4set )   ! end of the file definition

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90

@@ -12 +12 @@
 
    !                                             !!! ice thermodynamics
-   INTEGER, PUBLIC, PARAMETER ::   jkmax    = 6   !: maximum number of ice layers
    INTEGER, PUBLIC, PARAMETER ::   nlay_i   = 5   !: number of ice layers
    INTEGER, PUBLIC, PARAMETER ::   nlay_s   = 1   !: number of snow layers
@@ -18 +17 @@
    !                                             !!! ice mechanical redistribution
    INTEGER, PUBLIC, PARAMETER ::   jpl      = 5   !: number of ice categories
-   INTEGER, PUBLIC, PARAMETER ::   jpm      = 1   !: number of ice types
 
    !!----------------------------------------------------------------------

branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

@@ -34 +34 @@
    !!-----------------------------
    !: In ice thermodynamics, to spare memory, the vectors are folded
-   !: from 1D to 2D vectors. The following variables, with ending _1d (or _b)
+   !: from 1D to 2D vectors. The following variables, with ending _1d
    !: are the variables corresponding to 2d vectors
 
@@ -40 +40 @@
    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: correspondance between points (lateral accretion)
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d      !: <==> the 2D  qlead
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d    !: <==> the 2D  ftr_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d    !: <==> the 2D  qsr_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d     !: <==> the 2D  fr1_i0
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d     !: <==> the 2D  fr2_i0
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d    !: <==> the 2D  qns_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_b        !: <==> the 2D  t_bo
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d     
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_1d     
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sum_1d
@@ -65 +65 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_res_1d
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_ice_1d    !: <==> the 2D  wfx_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_1d    !: <==> the 2D  wfx_snw
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sub_1d    !: <==> the 2D  wfx_sub
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sub_1d
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bog_1d    !: <==> the 2D  wfx_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bom_1d    !: <==> the 2D  wfx_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sum_1d    !: <==> the 2D  wfx_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sni_1d    !: <==> the 2D  wfx_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_opw_1d    !: <==> the 2D  wfx_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_res_1d    !: <==> the 2D  wfx_ice
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_spr_1d    !: <==> the 2D  wfx_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bog_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bom_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sum_1d  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sni_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_opw_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_res_1d 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_spr_1d
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d    !: <==> the 2D sfx_bri
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bog_1d    !: 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bom_1d    !: 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sum_1d    !: 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sni_1d    !: 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_opw_1d    !:
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d    !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bog_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bom_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sum_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sni_1d    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_opw_1d   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d  
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_b        !: <==> the 2D  at_i
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhtur_1d       !: <==> the 2D  fhtur
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_1d        !: <==> the 2D  at_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhtur_1d      !: <==> the 2D  fhtur
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice
@@ -100 +99 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_se_1d   !: Ice salinity variations due to basal salt entrapment
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_si_1d   !: Ice salinity variations due to lateral accretion    
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_b       !: Ice collection thickness accumulated in fleads
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_1d      !: Ice collection thickness accumulated in leads
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_b      !: <==> the 2D  t_su
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_b       !: <==> the 2D  a_i
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_b      !: <==> the 2D  ht_s
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_b      !: <==> the 2D  ht_i
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su       !: Surface Conduction flux 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i     !: Bottom  Conduction flux 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot    !: Snow accretion/ablation        [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf   !: Ice surface accretion/ablation [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott   !: Ice bottom accretion/ablation  [m]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice  !: Snow ice formation             [m of ice]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_b      !: Ice bulk salinity [ppt]
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new     !: Salinity of new ice at the bottom
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_1d       !: <==> the 2D  t_su
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_1d        !: <==> the 2D  a_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_1d       !: <==> the 2D  ht_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_1d       !: <==> the 2D  ht_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su         !: Surface Conduction flux 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i       !: Bottom  Conduction flux 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot      !: Snow accretion/ablation        [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf     !: Ice surface accretion/ablation [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott     !: Ice bottom accretion/ablation  [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice    !: Snow ice formation             [m of ice]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_1d       !: Ice bulk salinity [ppt]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new       !: Salinity of new ice at the bottom
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   iatte_1d   !: clem attenuation coef of the input solar flux (unitless)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oatte_1d   !: clem attenuation coef of the input solar flux (unitless)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d   !: corresponding to the 2D var  t_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_1d   !: corresponding to the 2D var  t_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_1d   !: profiled ice salinity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_1d   !:    Ice  enthalpy per unit volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_1d   !:    Snow enthalpy per unit volume
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_b   !: corresponding to the 2D var  t_s
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_b   !: corresponding to the 2D var  t_i
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_b   !: profiled ice salinity
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_b   !:    Ice  enthalpy per unit volume
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_b   !:    Snow enthalpy per unit volume
-
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qh_i_old  !: ice heat content (q*h, J.m-2)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_old   !: ice thickness layer (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qh_i_old !: ice heat content (q*h, J.m-2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_old  !: ice thickness layer (m)
 
    INTEGER , PUBLIC ::   jiindex_1d   ! 1D index of debugging point
@@ -149 +145 @@
          &      qsr_ice_1d (jpij) ,     &
          &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) ,     &
-         &      t_bo_b   (jpij) , iatte_1d  (jpij) , oatte_1d (jpij) ,     &
-         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , &
+         &      t_bo_1d   (jpij) ,                                          &
+         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,     & 
+         &      hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , &
          &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , &
-         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , hfx_res_1d(jpij) , hfx_err_rem_1d(jpij),       STAT=ierr(1) )
+         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , &
+         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij),       STAT=ierr(1) )
       !
-      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_b     (jpij) ,     &
-         &      fhtur_1d   (jpij) , wfx_ice_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,     &
-         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) ,  wfx_res_1d (jpij) ,  &
+      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d     (jpij) ,     &
+         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,     &
+         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , &
+         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) ,  wfx_res_1d (jpij) ,  &
          &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     &
          &      tatm_ice_1d(jpij) ,      &   
          &      i0         (jpij) ,     &  
-         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) ,sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , &
+         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) ,   &
+         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , &
          &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &     
-         &      dsm_i_si_1d(jpij) , hicol_b    (jpij)                     , STAT=ierr(2) )
+         &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) )
       !
-      ALLOCATE( t_su_b    (jpij) , a_i_b    (jpij) , ht_i_b   (jpij) ,    &   
-         &      ht_s_b    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &    
+      ALLOCATE( t_su_1d    (jpij) , a_i_1d    (jpij) , ht_i_1d   (jpij) ,    &   
+         &      ht_s_1d    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &    
          &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &    
-         &      dh_snowice(jpij) , sm_i_b   (jpij) , s_i_new  (jpij) ,    &
-         &      t_s_b(jpij,nlay_s),                                       &
-         &      t_i_b(jpij,jkmax), s_i_b(jpij,jkmax)                ,     &            
-         &      q_i_b(jpij,jkmax), q_s_b(jpij,jkmax)                ,     &
-         &      qh_i_old(jpij,0:jkmax), h_i_old(jpij,0:jkmax) , STAT=ierr(3))
+         &      dh_snowice(jpij) , sm_i_1d   (jpij) , s_i_new  (jpij) ,    &
+         &      t_s_1d(jpij,nlay_s),                                       &
+         &      t_i_1d(jpij,nlay_i+1), s_i_1d(jpij,nlay_i+1)                ,     &            
+         &      q_i_1d(jpij,nlay_i+1), q_s_1d(jpij,nlay_i+1)                ,     &
+         &      qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3))
       !
       thd_ice_alloc = MAXVAL( ierr )