Changeset 14072 for NEMO/trunk/src/ICE

Timestamp:

2020-12-04T08:48:38+01:00 (3 years ago)

Author:

laurent

Message:

Merging branch "2020/dev_r13648_ASINTER-04_laurent_bulk_ice", ticket #2369

Location:

NEMO/trunk/src/ICE

Files:

• ice.F90 (modified) (18 diffs)
• icectl.F90 (modified) (35 diffs)
• icedia.F90 (modified) (15 diffs)
• icedyn.F90 (modified) (11 diffs)
• icedyn_adv_pra.F90 (modified) (47 diffs)
• icedyn_adv_umx.F90 (modified) (52 diffs)
• icedyn_rdgrft.F90 (modified) (47 diffs)
• icedyn_rhg.F90 (modified) (7 diffs)
• icedyn_rhg_eap.F90 (copied) (copied from NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_rhg_eap.F90)
• icedyn_rhg_evp.F90 (modified) (42 diffs)
• icedyn_rhg_vp.F90 (copied) (copied from NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_rhg_vp.F90)
• iceistate.F90 (modified) (18 diffs)
• iceitd.F90 (modified) (34 diffs)
• icerst.F90 (modified) (10 diffs)
• icesbc.F90 (modified) (14 diffs)
• icestp.F90 (modified) (10 diffs)
• icetab.F90 (modified) (1 diff)
• icethd.F90 (modified) (19 diffs)
• icethd_dh.F90 (modified) (35 diffs)
• icethd_pnd.F90 (modified) (67 diffs)
• icethd_zdf_bl99.F90 (modified) (37 diffs)
• iceupdate.F90 (modified) (17 diffs)
• icevar.F90 (modified) (47 diffs)
• icewri.F90 (modified) (9 diffs)

NEMO/trunk/src/ICE/ice.F90

@@ -64 +64 @@
    !! sv_i        |      -      |    Sea ice salt content         | pss.m |
    !! oa_i        |      -      |    Sea ice areal age content    | s     |
-   !! e_i         |             |    Ice enthalpy                 | J/m2  | 
-   !!             |    e_i_1d   |    Ice enthalpy per unit vol.   | J/m3  | 
-   !! e_s         |             |    Snow enthalpy                | J/m2  | 
-   !!             |    e_s_1d   |    Snow enthalpy per unit vol.  | J/m3  | 
+   !! e_i         |             |    Ice enthalpy                 | J/m2  |
+   !!             |    e_i_1d   |    Ice enthalpy per unit vol.   | J/m3  |
+   !! e_s         |             |    Snow enthalpy                | J/m2  |
+   !!             |    e_s_1d   |    Snow enthalpy per unit vol.  | J/m3  |
    !! a_ip        |      -      |    Ice pond concentration       |       |
    !! v_ip        |      -      |    Ice pond volume per unit area| m     |
@@ -108 +108 @@
    !! tm_i        |      -      |    Mean sea ice temperature     | K     |
    !! tm_s        |      -      |    Mean snow    temperature     | K     |
-   !! et_i        |      -      |    Total ice enthalpy           | J/m2  | 
-   !! et_s        |      -      |    Total snow enthalpy          | J/m2  | 
-   !! bv_i        |      -      |    relative brine volume        | ???   | 
+   !! et_i        |      -      |    Total ice enthalpy           | J/m2  |
+   !! et_s        |      -      |    Total snow enthalpy          | J/m2  |
+   !! bv_i        |      -      |    relative brine volume        | ???   |
    !! at_ip       |      -      |    Total ice pond concentration |       |
    !! hm_ip       |      -      |    Mean ice pond depth          | m     |
@@ -122 +122 @@
    !!----------------------------------------------------------------------
    !                                     !!** ice-generic parameters namelist (nampar) **
-   INTEGER           , PUBLIC ::   jpl              !: number of ice  categories 
-   INTEGER           , PUBLIC ::   nlay_i           !: number of ice  layers 
-   INTEGER           , PUBLIC ::   nlay_s           !: number of snow layers 
+   INTEGER           , PUBLIC ::   jpl              !: number of ice  categories
+   INTEGER           , PUBLIC ::   nlay_i           !: number of ice  layers
+   INTEGER           , PUBLIC ::   nlay_s           !: number of snow layers
    LOGICAL           , PUBLIC ::   ln_virtual_itd   !: virtual ITD mono-category parameterization (T) or not (F)
    LOGICAL           , PUBLIC ::   ln_icedyn        !: flag for ice dynamics (T) or not (F)
@@ -137 +137 @@
    !                                     !!** ice-itd namelist (namitd) **
    REAL(wp), PUBLIC ::   rn_himin         !: minimum ice thickness
-   
+
    !                                     !!** ice-dynamics namelist (namdyn) **
    REAL(wp), PUBLIC ::   rn_ishlat        !: lateral boundary condition for sea-ice
-   LOGICAL , PUBLIC ::   ln_landfast_L16  !: landfast ice parameterizationfrom lemieux2016 
+   LOGICAL , PUBLIC ::   ln_landfast_L16  !: landfast ice parameterizationfrom lemieux2016
    REAL(wp), PUBLIC ::   rn_lf_depfra     !:    fraction of ocean depth that ice must reach to initiate landfast ice
-   REAL(wp), PUBLIC ::   rn_lf_bfr        !:    maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home) 
+   REAL(wp), PUBLIC ::   rn_lf_bfr        !:    maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home)
    REAL(wp), PUBLIC ::   rn_lf_relax      !:    relaxation time scale (s-1) to reach static friction
    REAL(wp), PUBLIC ::   rn_lf_tensile    !:    isotropic tensile strength
@@ -153 +153 @@
    LOGICAL , PUBLIC ::   ln_rhg_EVP       ! EVP rheology switch, used for rdgrft and rheology
    LOGICAL , PUBLIC ::   ln_rhg_EAP       ! EAP rheology switch, used for rdgrft and rheology
-   LOGICAL , PUBLIC ::   ln_aEVP          !: using adaptive EVP (T or F) 
+   LOGICAL , PUBLIC ::   ln_aEVP          !: using adaptive EVP (T or F)
    REAL(wp), PUBLIC ::   rn_creepl        !: creep limit (has to be low enough, circa 10-9 m/s, depending on rheology)
    REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve
    INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling
-   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rDt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 
-   INTEGER , PUBLIC ::   nn_rhg_chkcvg    !: check ice rheology convergence 
+   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rDt_ice (1/3 or 1/9 depending on nb of subcycling nevp)
+   INTEGER , PUBLIC ::   nn_rhg_chkcvg    !: check ice rheology convergence
    ! -- vp
    LOGICAL , PUBLIC ::   ln_rhg_VP        !: VP rheology
@@ -181 +181 @@
    INTEGER , PUBLIC ::   nn_flxdist       !: Redistribute heat flux over ice categories
    !                                      !   =-1  Do nothing (needs N(cat) fluxes)
-   !                                      !   = 0  Average N(cat) fluxes then apply the average over the N(cat) ice 
+   !                                      !   = 0  Average N(cat) fluxes then apply the average over the N(cat) ice
    !                                      !   = 1  Average N(cat) fluxes then redistribute over the N(cat) ice using T-ice and albedo sensitivity
    !                                      !   = 2  Redistribute a single flux over categories
                                           ! -- icethd_zdf -- !
-   LOGICAL , PUBLIC ::   ln_cndflx        !: use conduction flux as surface boundary condition (instead of qsr and qns) 
-   LOGICAL , PUBLIC ::   ln_cndemulate    !: emulate conduction flux (if not provided) 
+   LOGICAL , PUBLIC ::   ln_cndflx        !: use conduction flux as surface boundary condition (instead of qsr and qns)
+   LOGICAL , PUBLIC ::   ln_cndemulate    !: emulate conduction flux (if not provided)
    !                                      ! Conduction flux as surface forcing or not
    INTEGER, PUBLIC, PARAMETER ::   np_cnd_OFF = 0  !: no forcing from conduction flux (ice thermodynamics forced via qsr and qns)
@@ -192 +192 @@
    INTEGER, PUBLIC, PARAMETER ::   np_cnd_EMU = 2  !: emulate conduction flux via icethd_zdf.F90 (BL99) (1st round compute qcn and qsr_tr, 2nd round use it)
    INTEGER, PUBLIC ::   nn_qtrice         !: Solar flux transmitted thru the surface scattering layer:
-   !                                      !   = 0  Grenfell and Maykut 1977 (depends on cloudiness and is 0 when there is snow) 
+   !                                      !   = 0  Grenfell and Maykut 1977 (depends on cloudiness and is 0 when there is snow)
    !                                      !   = 1  Lebrun 2019 (equals 0.3 anytime with different melting/dry snw conductivities)
    !
@@ -198 +198 @@
    LOGICAL , PUBLIC ::   ln_cndi_U64      !: thermal conductivity: Untersteiner (1964)
    LOGICAL , PUBLIC ::   ln_cndi_P07      !: thermal conductivity: Pringle et al (2007)
-   REAL(wp), PUBLIC ::   rn_cnd_s         !: thermal conductivity of the snow [W/m/K]   
+   REAL(wp), PUBLIC ::   rn_cnd_s         !: thermal conductivity of the snow [W/m/K]
    REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation in sea ice, Grenfell et al. (2006) [1/m]
    REAL(wp), PUBLIC ::   rn_kappa_s       !: coef. for the extinction of radiation in snw (nn_qtrice=0) [1/m]
@@ -236 +236 @@
    INTEGER , PUBLIC ::   jiceprt          !: debug j-point
 
-   !                                     !!** some other parameters 
+   !                                     !!** some other parameters
    INTEGER , PUBLIC ::   kt_ice           !: iteration number
    REAL(wp), PUBLIC ::   rDt_ice          !: ice time step
    REAL(wp), PUBLIC ::   r1_Dt_ice        !: = 1. / rDt_ice
    REAL(wp), PUBLIC ::   r1_nlay_i        !: 1 / nlay_i
-   REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s 
+   REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s
    REAL(wp), PUBLIC ::   rswitch          !: switch for the presence of ice (1) or not (0)
    REAL(wp), PUBLIC ::   rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft   !: conservation diagnostics
-   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, 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
 
    !                                     !!** define arrays
@@ -259 +259 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdg_conv
    !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   t_bo            !: Sea-Ice bottom temperature [Kelvin]     
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   t_bo            !: Sea-Ice bottom temperature [Kelvin]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qlead           !: heat balance of the lead (or of the open ocean)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qsb_ice_bot     !: net downward heat flux from the ice to the ocean
@@ -306 +306 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qt_atm_oi       !: heat flux at the interface atm-[oce+ice]            [W.m-2]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qt_oce_ai       !: heat flux at the interface oce-[atm+ice]            [W.m-2]
-   
+
    ! heat flux associated with ice-atmosphere mass exchange
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_sub         !: heat flux for sublimation            [W.m-2]
@@ -389 +389 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                     !: ice concentration (total)
-            
+
    !!----------------------------------------------------------------------
    !! * Ice thickness distribution variables
    !!----------------------------------------------------------------------
    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 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean           !: Mean ice thickness in catgories
    !
    !!----------------------------------------------------------------------
@@ -405 +405 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_sv       !: transport of salt content
    !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_heat         !: snw/ice heat content variation   [W/m2] 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_sice         !: ice salt content variation   [] 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vice         !: ice volume variation   [m/s] 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vsnw         !: snw volume variation   [m/s] 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_aice         !: ice conc.  variation   [s-1] 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vpnd         !: pond volume variation  [m/s] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_heat         !: snw/ice heat content variation   [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_sice         !: ice salt content variation   []
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vice         !: ice volume variation   [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vsnw         !: snw volume variation   [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_aice         !: ice conc.  variation   [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vpnd         !: pond volume variation  [m/s]
    !
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_adv_mass     !: advection of mass (kg/m2/s)
@@ -430 +430 @@
    !!----------------------------------------------------------------------
    ! Extra sea ice diagnostics to address the data request
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_si            !: Temperature at Snow-ice interface (K) 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tm_si           !: mean temperature at the snow-ice interface (K) 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_si            !: Temperature at Snow-ice interface (K)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tm_si           !: mean temperature at the snow-ice interface (K)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_bot     !: Bottom  conduction flux (W/m2)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_top     !: Surface conduction flux (W/m2)
@@ -469 +469 @@
          &      sfx_res    (jpi,jpj) , sfx_bri   (jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) ,  &
          &      sfx_bog    (jpi,jpj) , sfx_bom   (jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,  &
-         &      hfx_res    (jpi,jpj) , hfx_snw   (jpi,jpj) , hfx_sub(jpi,jpj) ,                        & 
+         &      hfx_res    (jpi,jpj) , hfx_snw   (jpi,jpj) , hfx_sub(jpi,jpj) ,                        &
          &      qt_atm_oi  (jpi,jpj) , qt_oce_ai (jpi,jpj) , fhld   (jpi,jpj) ,                        &
          &      hfx_sum    (jpi,jpj) , hfx_bom   (jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     &
@@ -513 +513 @@
       ii = ii + 1
       ALLOCATE( u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , at_i_b(jpi,jpj) , STAT=ierr(ii) )
-      
+
       ! * Ice thickness distribution variables
       ii = ii + 1
@@ -520 +520 @@
       ! * Ice diagnostics
       ii = ii + 1
-      ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj),                      & 
+      ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj),                      &
          &      diag_trp_es(jpi,jpj) , diag_trp_sv (jpi,jpj) , diag_heat  (jpi,jpj),                      &
          &      diag_sice  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), diag_aice(jpi,jpj), diag_vpnd(jpi,jpj),  &
@@ -527 +527 @@
       ! * Ice conservation
       ii = ii + 1
-      ALLOCATE( diag_v (jpi,jpj) , diag_s (jpi,jpj) , diag_t (jpi,jpj),   & 
+      ALLOCATE( diag_v (jpi,jpj) , diag_s (jpi,jpj) , diag_t (jpi,jpj),   &
          &      diag_fv(jpi,jpj) , diag_fs(jpi,jpj) , diag_ft(jpi,jpj), STAT=ierr(ii) )
-      
+
       ! * SIMIP diagnostics
       ii = ii + 1

NEMO/trunk/src/ICE/icectl.F90

@@ -12 +12 @@
    !!   'key_si3'                                       SI3 sea-ice model
    !!----------------------------------------------------------------------
-   !!    ice_cons_hsm     : conservation tests on heat, salt and mass during a  time step (global) 
+   !!    ice_cons_hsm     : conservation tests on heat, salt and mass during a  time step (global)
    !!    ice_cons_final   : conservation tests on heat, salt and mass at end of time step (global)
    !!    ice_cons2D       : conservation tests on heat, salt and mass at each gridcell
@@ -55 +55 @@
    CHARACTER(LEN=50)   ::   clname="icedrift_diagnostics.ascii"   ! ascii filename
    INTEGER             ::   numicedrift                           ! outfile unit
-   REAL(wp)            ::   rdiag_icemass, rdiag_icesalt, rdiag_iceheat 
-   REAL(wp)            ::   rdiag_adv_icemass, rdiag_adv_icesalt, rdiag_adv_iceheat 
-   
+   REAL(wp)            ::   rdiag_icemass, rdiag_icesalt, rdiag_iceheat
+   REAL(wp)            ::   rdiag_adv_icemass, rdiag_adv_icesalt, rdiag_adv_iceheat
+
    !! * Substitutions
 #  include "do_loop_substitute.h90"
@@ -77 +77 @@
       !!              It prints in ocean.output if there is a violation of conservation at each time-step
       !!              The thresholds (zchk_m, zchk_s, zchk_t) determine violations
-      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
-      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
+      !!              For salt and heat thresholds, ice is considered to have a salinity of 10
+      !!              and a heat content of 3e5 J/kg (=latent heat of fusion)
       !!-------------------------------------------------------------------
       INTEGER         , INTENT(in)    ::   icount        ! called at: =0 the begining of the routine, =1  the end
@@ -148 +148 @@
          zetrp = glob_sum( 'icectl', diag_adv_heat * e1e2t )
 
-         ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 
+         ! ice area (+epsi10 to set a threshold > 0 when there is no ice)
          zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t )
 
@@ -191 +191 @@
       !!              It prints in ocean.output if there is a violation of conservation at each time-step
       !!              The thresholds (zchk_m, zchk_s, zchk_t) determine the violations
-      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
-      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
+      !!              For salt and heat thresholds, ice is considered to have a salinity of 10
+      !!              and a heat content of 3e5 J/kg (=latent heat of fusion)
       !!-------------------------------------------------------------------
       CHARACTER(len=*), INTENT(in) ::   cd_routine    ! name of the routine
@@ -214 +214 @@
       !!   &                                          ) * e1e2t )
 
-      ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 
+      ! ice area (+epsi10 to set a threshold > 0 when there is no ice)
       zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t )
 
@@ -243 +243 @@
       !!
       REAL(wp), DIMENSION(jpi,jpj) ::   zdiag_mass, zdiag_salt, zdiag_heat, &
-         &                              zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax  
+         &                              zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax
       INTEGER ::   jl, jk
       LOGICAL ::   ll_stop_m = .FALSE.
@@ -261 +261 @@
             &       wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr
          ! salt flux
-         pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam 
+         pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam
          ! heat flux
-         pdiag_ft =   hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw  & 
+         pdiag_ft =   hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw  &
             &       - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr
 
@@ -283 +283 @@
          ! -- heat diag -- !
          zdiag_heat =   ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_Dt_ice &
-            &         + (  hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw                                & 
+            &         + (  hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw                                &
             &            - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr )                                        &
             &         - pdiag_ft
@@ -324 +324 @@
          IF( ll_stop_s )   CALL ctl_stop( 'STOP', cd_routine//': ice salt conservation issue' )
          IF( ll_stop_t )   CALL ctl_stop( 'STOP', cd_routine//': ice heat conservation issue' )
-         
+
       ENDIF
 
@@ -332 +332 @@
       !!---------------------------------------------------------------------
       !!                 ***  ROUTINE ice_cons_wri  ***
-      !!        
-      !! ** Purpose :   create a NetCDF file named cdfile_name which contains 
+      !!
+      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
       !!                the instantaneous fields when conservation issue occurs
       !!
@@ -340 +340 @@
       CHARACTER(len=*), INTENT( in ) ::   cdfile_name      ! name of the file created
       REAL(wp), DIMENSION(:,:), INTENT( in ) ::   pdiag_mass, pdiag_salt, pdiag_heat, &
-         &                                        pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax  
+         &                                        pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax
       !!
       INTEGER ::   inum
       !!----------------------------------------------------------------------
-      ! 
+      !
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'ice_cons_wri : single instantaneous ice state'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~  named :', cdfile_name, '...nc'
-      IF(lwp) WRITE(numout,*)                
+      IF(lwp) WRITE(numout,*)
 
       CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' )
-      
+
       CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 )    ! ice mass spurious lost/gain
       CALL iom_rstput( 0, 0, inum, 'cons_salt', pdiag_salt(:,:) , ktype = jp_r8 )    ! ice salt spurious lost/gain
       CALL iom_rstput( 0, 0, inum, 'cons_heat', pdiag_heat(:,:) , ktype = jp_r8 )    ! ice heat spurious lost/gain
       ! other diags
-      CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 )    ! 
-      CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 )    ! 
-      CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 )    ! 
-      CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 )    ! 
+      CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 )    !
+      CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 )    !
+      CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 )    !
+      CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 )    !
       ! mean state
       CALL iom_rstput( 0, 0, inum, 'icecon'    , SUM(a_i ,dim=3) , ktype = jp_r8 )    !
@@ -366 +366 @@
       CALL iom_rstput( 0, 0, inum, 'pndvol'    , SUM(v_ip,dim=3) , ktype = jp_r8 )    !
       CALL iom_rstput( 0, 0, inum, 'lidvol'    , SUM(v_il,dim=3) , ktype = jp_r8 )    !
-      
+
       CALL iom_close( inum )
 
    END SUBROUTINE ice_cons_wri
-   
+
    SUBROUTINE ice_ctl( kt )
       !!-------------------------------------------------------------------
-      !!                   ***  ROUTINE ice_ctl *** 
-      !!                 
+      !!                   ***  ROUTINE ice_ctl ***
+      !!
       !! ** Purpose :   control checks
       !!-------------------------------------------------------------------
@@ -386 +386 @@
       inb_alp(:) = 0
       ialert_id = 0
-      
+
       ! Alert if very high salinity
       ialert_id = ialert_id + 1 ! reference number of this alert
@@ -430 +430 @@
          END_3D
       END DO
-  
+
       ! Alert if very warm ice
       ialert_id = ialert_id + 1 ! reference number of this alert
@@ -444 +444 @@
          END_3D
       END DO
-      
+
       ! Alerte if very thick ice
       ialert_id = ialert_id + 1 ! reference number of this alert
       cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert
-      jl = jpl 
+      jl = jpl
       DO_2D( 1, 1, 1, 1 )
          IF( h_i(ji,jj,jl) > 50._wp ) THEN
@@ -460 +460 @@
       ialert_id = ialert_id + 1 ! reference number of this alert
       cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert
-      jl = 1 
+      jl = 1
       DO_2D( 1, 1, 1, 1 )
          IF( h_i(ji,jj,jl) < rn_himin ) THEN
@@ -484 +484 @@
       cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert
       DO_2D( 1, 1, 1, 1 )
-         IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN 
+         IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN
             WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj)
             WRITE(numout,*) ' at i,j = ',ji,jj
@@ -496 +496 @@
       DO_2D( 1, 1, 1, 1 )
          IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. &
-            & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN 
+            & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN
             WRITE(numout,*) ' ALERTE :   Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj)
             WRITE(numout,*) ' at i,j = ',ji,jj
@@ -520 +520 @@
      !
    END SUBROUTINE ice_ctl
- 
+
    SUBROUTINE ice_prt( kt, ki, kj, kn, cd1 )
       !!-------------------------------------------------------------------
-      !!                   ***  ROUTINE ice_prt *** 
-      !!                 
-      !! ** Purpose :   Writes global ice state on the (i,j) point 
-      !!                in ocean.ouput 
-      !!                3 possibilities exist 
+      !!                   ***  ROUTINE ice_prt ***
+      !!
+      !! ** Purpose :   Writes global ice state on the (i,j) point
+      !!                in ocean.ouput
+      !!                3 possibilities exist
       !!                n = 1/-1 -> simple ice state
       !!                n = 2    -> exhaustive state
       !!                n = 3    -> ice/ocean salt fluxes
       !!
-      !! ** input   :   point coordinates (i,j) 
+      !! ** input   :   point coordinates (i,j)
       !!                n : number of the option
       !!-------------------------------------------------------------------
@@ -550 +550 @@
             !  Simple state
             !----------------
-            
+
             IF ( kn == 1 .OR. kn == -1 ) THEN
                WRITE(numout,*) ' ice_prt - Point : ',ji,jj
@@ -566 +566 @@
                WRITE(numout,*) ' - Cell values '
                WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
-               WRITE(numout,*) ' ato_i         : ', ato_i(ji,jj)       
-               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
-               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
+               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)
+               WRITE(numout,*) ' ato_i         : ', ato_i(ji,jj)
+               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)
+               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)
                DO jl = 1, jpl
                   WRITE(numout,*) ' - Category (', jl,')'
@@ -592 +592 @@
             !  Exhaustive state
             !--------------------
-            
+
             IF ( kn .EQ. 2 ) THEN
                WRITE(numout,*) ' ice_prt - Point : ',ji,jj
@@ -598 +598 @@
                WRITE(numout,*) ' Exhaustive state '
                WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
-               WRITE(numout,*) 
+               WRITE(numout,*)
                WRITE(numout,*) ' - Cell values '
                WRITE(numout,*) '   ~~~~~~~~~~~ '
-               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)       
-               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)       
-               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)       
+               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)
+               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)
+               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)
                WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj)
                WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj)
@@ -610 +610 @@
                WRITE(numout,*) ' strength      : ', strength(ji,jj)
                WRITE(numout,*)
-               
+
                DO jl = 1, jpl
                   WRITE(numout,*) ' - Category (',jl,')'
-                  WRITE(numout,*) '   ~~~~~~~~         ' 
+                  WRITE(numout,*) '   ~~~~~~~~         '
                   WRITE(numout,*) ' h_i        : ', h_i(ji,jj,jl)              , ' h_s        : ', h_s(ji,jj,jl)
                   WRITE(numout,*) ' t_i        : ', t_i(ji,jj,1:nlay_i,jl)
                   WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)             , ' t_s        : ', t_s(ji,jj,1:nlay_s,jl)
                   WRITE(numout,*) ' s_i        : ', s_i(ji,jj,jl)              , ' o_i        : ', o_i(ji,jj,jl)
-                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)   
-                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)   
-                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)  
-                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)            , ' ei1        : ', e_i_b(ji,jj,1,jl) 
-                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)            , ' ei2_b      : ', e_i_b(ji,jj,2,jl)  
-                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl) 
-                  WRITE(numout,*) ' sv_i       : ', sv_i(ji,jj,jl)             , ' sv_i_b     : ', sv_i_b(ji,jj,jl)   
+                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)
+                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)
+                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)
+                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)            , ' ei1        : ', e_i_b(ji,jj,1,jl)
+                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)            , ' ei2_b      : ', e_i_b(ji,jj,2,jl)
+                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl)
+                  WRITE(numout,*) ' sv_i       : ', sv_i(ji,jj,jl)             , ' sv_i_b     : ', sv_i_b(ji,jj,jl)
                END DO !jl
-               
+
                WRITE(numout,*)
                WRITE(numout,*) ' - Heat / FW fluxes '
@@ -634 +634 @@
                WRITE(numout,*) ' qns_ini       : ', (1._wp-at_i_b(ji,jj)) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) )
                WRITE(numout,*)
-               WRITE(numout,*) 
-               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)  
-               WRITE(numout,*) ' sss        : ', sss_m(ji,jj)  
-               WRITE(numout,*) 
+               WRITE(numout,*)
+               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)
+               WRITE(numout,*) ' sss        : ', sss_m(ji,jj)
+               WRITE(numout,*)
                WRITE(numout,*) ' - Stresses '
                WRITE(numout,*) '   ~~~~~~~~ '
-               WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj) 
+               WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj)
                WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ji,jj)
-               WRITE(numout,*) ' utau       : ', utau    (ji,jj) 
+               WRITE(numout,*) ' utau       : ', utau    (ji,jj)
                WRITE(numout,*) ' vtau       : ', vtau    (ji,jj)
             ENDIF
-            
+
             !---------------------
             ! Salt / heat fluxes
             !---------------------
-            
+
             IF ( kn .EQ. 3 ) THEN
                WRITE(numout,*) ' ice_prt - Point : ',ji,jj
@@ -664 +664 @@
                WRITE(numout,*) ' qt_atm_oi    : ', qt_atm_oi(ji,jj)
                WRITE(numout,*) ' qt_oce_ai    : ', qt_oce_ai(ji,jj)
-               WRITE(numout,*) ' dhc          : ', diag_heat(ji,jj)              
+               WRITE(numout,*) ' dhc          : ', diag_heat(ji,jj)
                WRITE(numout,*)
                WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj)
                WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj)
                WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj)
-               WRITE(numout,*) ' qsb_ice_bot  : ', qsb_ice_bot(ji,jj) 
+               WRITE(numout,*) ' qsb_ice_bot  : ', qsb_ice_bot(ji,jj)
                WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_Dt_ice
                WRITE(numout,*)
@@ -680 +680 @@
                WRITE(numout,*)
                WRITE(numout,*) ' - Momentum fluxes '
-               WRITE(numout,*) ' utau      : ', utau(ji,jj) 
+               WRITE(numout,*) ' utau      : ', utau(ji,jj)
                WRITE(numout,*) ' vtau      : ', vtau(ji,jj)
-            ENDIF 
+            ENDIF
             WRITE(numout,*) ' '
             !
@@ -694 +694 @@
       !!                  ***  ROUTINE ice_prt3D ***
       !!
-      !! ** Purpose : CTL prints of ice arrays in case sn_cfctl%prtctl is activated 
+      !! ** Purpose : CTL prints of ice arrays in case sn_cfctl%prtctl is activated
       !!
       !!-------------------------------------------------------------------
       CHARACTER(len=*), INTENT(in) ::   cd_routine    ! name of the routine
       INTEGER                      ::   jk, jl        ! dummy loop indices
-      
+
       CALL prt_ctl_info(' ========== ')
       CALL prt_ctl_info( cd_routine )
@@ -718 +718 @@
       CALL prt_ctl(tab2d_1=delta_i    , clinfo1=' delta_i     :')
       CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :')
-       
+
       DO jl = 1, jpl
          CALL prt_ctl_info(' ')
@@ -735 +735 @@
          CALL prt_ctl(tab2d_1=sv_i       (:,:,jl)        , clinfo1= ' sv_i        : ')
          CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' oa_i        : ')
-         
+
          DO jk = 1, nlay_i
             CALL prt_ctl_info(' - Layer : ', ivar=jk)
@@ -742 +742 @@
          END DO
       END DO
-      
+
       CALL prt_ctl_info(' ')
       CALL prt_ctl_info(' - Stresses : ')
@@ -748 +748 @@
       CALL prt_ctl(tab2d_1=utau       , clinfo1= ' utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ')
       CALL prt_ctl(tab2d_1=utau_ice   , clinfo1= ' utau_ice  : ', tab2d_2=vtau_ice   , clinfo2= ' vtau_ice  : ')
-      
+
    END SUBROUTINE ice_prt3D
 
@@ -853 +853 @@
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ice_drift_init  ***
-      !!                   
+      !!
       !! ** Purpose :   create output file, initialise arrays
       !!----------------------------------------------------------------------
@@ -879 +879 @@
       !
    END SUBROUTINE ice_drift_init
-      
+
 #else
    !!----------------------------------------------------------------------

NEMO/trunk/src/ICE/icedia.F90

@@ -2 +2 @@
    !!======================================================================
    !!                       ***  MODULE icedia  ***
-   !!  Sea-Ice:   global budgets 
+   !!  Sea-Ice:   global budgets
    !!======================================================================
    !! History :  3.4  !  2012-10  (C. Rousset)       original code
@@ -37 +37 @@
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   vol_loc_ini, sal_loc_ini, tem_loc_ini                    ! initial volume, salt and heat contents
    REAL(wp)                              ::   frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot  ! global forcing trends
-   
+
    !!----------------------------------------------------------------------
    !! NEMO/ICE 4.0 , NEMO Consortium (2018)
@@ -59 +59 @@
       !!---------------------------------------------------------------------------
       !!                  ***  ROUTINE ice_dia  ***
-      !!     
-      !! ** Purpose:   Compute the sea-ice global heat content, salt content 
+      !!
+      !! ** Purpose:   Compute the sea-ice global heat content, salt content
       !!             and volume conservation
       !!---------------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! ocean time step 
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
       !!
       REAL(wp)   ::   zbg_ivol, zbg_item, zbg_area, zbg_isal
       REAL(wp)   ::   zbg_svol, zbg_stem
       REAL(wp)   ::   z_frc_voltop, z_frc_temtop, z_frc_sal
-      REAL(wp)   ::   z_frc_volbot, z_frc_tembot  
-      REAL(wp)   ::   zdiff_vol, zdiff_sal, zdiff_tem  
+      REAL(wp)   ::   z_frc_volbot, z_frc_tembot
+      REAL(wp)   ::   zdiff_vol, zdiff_sal, zdiff_tem
       !!---------------------------------------------------------------------------
       IF( ln_timing )   CALL timing_start('ice_dia')
@@ -82 +82 @@
          z1_e1e2 = 1._wp / glob_sum( 'icedia', e1e2t(:,:) )
       ENDIF
-      
+
       ! ----------------------- !
       ! 1 -  Contents           !
@@ -96 +96 @@
          zbg_stem = glob_sum( 'icedia', et_s(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J)
 
-         CALL iom_put( 'ibgvol_tot'  , zbg_ivol ) 
-         CALL iom_put( 'sbgvol_tot'  , zbg_svol ) 
-         CALL iom_put( 'ibgarea_tot' , zbg_area ) 
-         CALL iom_put( 'ibgsalt_tot' , zbg_isal ) 
-         CALL iom_put( 'ibgheat_tot' , zbg_item ) 
-         CALL iom_put( 'sbgheat_tot' , zbg_stem ) 
- 
+         CALL iom_put( 'ibgvol_tot'  , zbg_ivol )
+         CALL iom_put( 'sbgvol_tot'  , zbg_svol )
+         CALL iom_put( 'ibgarea_tot' , zbg_area )
+         CALL iom_put( 'ibgsalt_tot' , zbg_isal )
+         CALL iom_put( 'ibgheat_tot' , zbg_item )
+         CALL iom_put( 'sbgheat_tot' , zbg_stem )
+
       ENDIF
 
@@ -109 +109 @@
       ! ---------------------------!
       ! they must be kept outside an IF(iom_use) because of the call to dia_rst below
-      z_frc_volbot = r1_rho0 * glob_sum( 'icedia', -( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-ocean 
+      z_frc_volbot = r1_rho0 * glob_sum( 'icedia', -( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-ocean
       z_frc_voltop = r1_rho0 * glob_sum( 'icedia', -( wfx_sub(:,:) + wfx_spr(:,:) )                    * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-atm
       z_frc_sal    = r1_rho0 * glob_sum( 'icedia', -      sfx(:,:)                                     * e1e2t(:,:) ) * 1.e-9   ! salt fluxes ice/snow-ocean
@@ -121 +121 @@
       frc_tembot  = frc_tembot  + z_frc_tembot  * rDt_ice ! 1.e20 J
 
-      CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water) 
-      CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water) 
-      CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)   
-      CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)   
-      CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)   
+      CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water)
+      CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water)
+      CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)
+      CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)
+      CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)
 
       IF(  iom_use('ibgfrchfxtop') .OR. iom_use('ibgfrchfxbot') ) THEN
          CALL iom_put( 'ibgfrchfxtop' , frc_temtop * z1_e1e2 * 1.e-20 * kt*rn_Dt ) ! heat on top of ice/snw/ocean      (W/m2)
-         CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rn_Dt ) ! heat on top of ocean(below ice)   (W/m2) 
-      ENDIF
-      
+         CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rn_Dt ) ! heat on top of ocean(below ice)   (W/m2)
+      ENDIF
+
       ! ---------------------------------- !
       ! 3 -  Content variations and drifts !
       ! ---------------------------------- !
       IF(  iom_use('ibgvolume') .OR. iom_use('ibgsaltco') .OR. iom_use('ibgheatco') .OR. iom_use('ibgheatfx') ) THEN
-            
-         zdiff_vol = r1_rho0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3) 
+
+         zdiff_vol = r1_rho0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3)
          zdiff_sal = r1_rho0 * glob_sum( 'icedia', ( rhoi*st_i(:,:)                  - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! salt content trend (km3*pss)
          zdiff_tem =           glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:)           - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20  ! heat content trend (1.e20 J)
          !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check)
-         
+
          zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot )
          zdiff_sal = zdiff_sal - frc_sal
          zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop )
-         
-         CALL iom_put( 'ibgvolume' , zdiff_vol )   ! ice/snow volume  drift            (km3 equivalent ocean water)         
+
+         CALL iom_put( 'ibgvolume' , zdiff_vol )   ! ice/snow volume  drift            (km3 equivalent ocean water)
          CALL iom_put( 'ibgsaltco' , zdiff_sal )   ! ice salt content drift            (psu*km3 equivalent ocean water)
          CALL iom_put( 'ibgheatco' , zdiff_tem )   ! ice/snow heat content drift       (1.e20 J)
          !
       ENDIF
-      
+
       IF( lrst_ice )   CALL ice_dia_rst( 'WRITE', kt_ice )
       !
@@ -162 +162 @@
       !!---------------------------------------------------------------------------
       !!                  ***  ROUTINE ice_dia_init  ***
-      !!     
+      !!
       !! ** Purpose: Initialization for the heat salt volume budgets
-      !! 
+      !!
       !! ** Method : Compute initial heat content, salt content and volume
       !!
@@ -173 +173 @@
       INTEGER            ::   ios, ierror   ! local integer
       !!
-      NAMELIST/namdia/ ln_icediachk, rn_icechk_cel, rn_icechk_glo, ln_icediahsb, ln_icectl, iiceprt, jiceprt  
+      NAMELIST/namdia/ ln_icediachk, rn_icechk_cel, rn_icechk_glo, ln_icediahsb, ln_icectl, iiceprt, jiceprt
       !!----------------------------------------------------------------------
       !
@@ -194 +194 @@
          WRITE(numout,*) '         chosen grid point position          (iiceprt,jiceprt)  = (', iiceprt,',', jiceprt,')'
       ENDIF
-      !      
+      !
       IF( ln_icediahsb ) THEN
          IF( ice_dia_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'ice_dia_init : unable to allocate arrays' )   ! allocate tke arrays
@@ -206 +206 @@
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE icedia_rst  ***
-      !!                     
+      !!
       !! ** Purpose :   Read or write DIA file in restart file
       !!
@@ -218 +218 @@
       !!----------------------------------------------------------------------
       !
-      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
+      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise
          IF( ln_rstart ) THEN                   !* Read the restart file
             !
@@ -238 +238 @@
             IF(lwp) WRITE(numout,*) '~~~~~~~'
             ! set trends to 0
-            frc_voltop  = 0._wp                                          
-            frc_volbot  = 0._wp                                          
-            frc_temtop  = 0._wp                                                 
-            frc_tembot  = 0._wp                                                 
-            frc_sal     = 0._wp                                                 
+            frc_voltop  = 0._wp
+            frc_volbot  = 0._wp
+            frc_temtop  = 0._wp
+            frc_tembot  = 0._wp
+            frc_sal     = 0._wp
             ! record initial ice volume, salt and temp
             vol_loc_ini(:,:) = rhoi * vt_i(:,:) + rhos * vt_s(:,:)  ! ice/snow volume (kg/m2)
@@ -260 +260 @@
          !
          ! Write in numriw (if iter == nitrst)
-         ! ------------------ 
+         ! ------------------
          CALL iom_rstput( iter, nitrst, numriw, 'frc_voltop' , frc_voltop )
          CALL iom_rstput( iter, nitrst, numriw, 'frc_volbot' , frc_volbot )
@@ -273 +273 @@
       !
    END SUBROUTINE ice_dia_rst
- 
+
 #else
    !!----------------------------------------------------------------------

NEMO/trunk/src/ICE/icedyn.F90

@@ -2 +2 @@
    !!======================================================================
    !!                     ***  MODULE  icedyn  ***
-   !!   Sea-Ice dynamics : master routine for sea ice dynamics 
+   !!   Sea-Ice dynamics : master routine for sea ice dynamics
    !!======================================================================
    !! history :  4.0  ! 2018  (C. Rousset)  original code SI3 [aka Sea Ice cube]
@@ -36 +36 @@
    PUBLIC   ice_dyn        ! called by icestp.F90
    PUBLIC   ice_dyn_init   ! called by icestp.F90
-   
+
    INTEGER ::              nice_dyn   ! choice of the type of dynamics
    !                                        ! associated indices:
    INTEGER, PARAMETER ::   np_dynALL     = 1   ! full ice dynamics               (rheology + advection + ridging/rafting + correction)
-   INTEGER, PARAMETER ::   np_dynRHGADV  = 2   ! pure dynamics                   (rheology + advection) 
+   INTEGER, PARAMETER ::   np_dynRHGADV  = 2   ! pure dynamics                   (rheology + advection)
    INTEGER, PARAMETER ::   np_dynADV1D   = 3   ! only advection 1D - test case from Schar & Smolarkiewicz 1996
    INTEGER, PARAMETER ::   np_dynADV2D   = 4   ! only advection 2D w prescribed vel.(rn_uvice + advection)
@@ -51 +51 @@
    REAL(wp) ::   rn_uice          !    prescribed u-vel (case np_dynADV1D & np_dynADV2D)
    REAL(wp) ::   rn_vice          !    prescribed v-vel (case np_dynADV1D & np_dynADV2D)
-   
+
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_icbmsk   ! structure of input grounded icebergs mask (file informations, fields read)
 
@@ -66 +66 @@
       !!-------------------------------------------------------------------
       !!               ***  ROUTINE ice_dyn  ***
-      !!               
+      !!
       !! ** Purpose :   this routine manages sea ice dynamics
       !!
@@ -91 +91 @@
          WRITE(numout,*)'~~~~~~~'
       ENDIF
-      !                      
+      !
       ! retrieve thickness from volume for landfast param. and UMx advection scheme
       WHERE( a_i(:,:,:) >= epsi20 )
@@ -118 +118 @@
       CASE ( np_dynALL )           !==  all dynamical processes  ==!
          !
-         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology  
+         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology
          CALL ice_dyn_adv   ( kt )                                          ! -- advection of ice
-         CALL ice_dyn_rdgrft( kt )                                          ! -- ridging/rafting 
+         CALL ice_dyn_rdgrft( kt )                                          ! -- ridging/rafting
          CALL ice_cor       ( kt , 1 )                                      ! -- Corrections
          !
       CASE ( np_dynRHGADV  )       !==  no ridge/raft & no corrections ==!
          !
-         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology  
+         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology
          CALL ice_dyn_adv   ( kt )                                          ! -- advection of ice
          CALL Hpiling                                                       ! -- simple pile-up (replaces ridging/rafting)
@@ -134 +134 @@
          ! --- monotonicity test from Schar & Smolarkiewicz 1996 --- !
          ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length
-         ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s 
+         ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s
          DO_2D( 1, 1, 1, 1 )
             zcoefu = ( REAL(jpiglo+1)*0.5_wp - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5_wp - 1._wp )
@@ -156 +156 @@
       !
       !
-      ! diagnostics: divergence at T points 
+      ! diagnostics: divergence at T points
       IF( iom_use('icediv') ) THEN
          !
@@ -259 +259 @@
       ENDIF
       !                             !== set the choice of ice dynamics ==!
-      ioptio = 0 
+      ioptio = 0
       !      !--- full dynamics                               (rheology + advection + ridging/rafting + correction)
       IF( ln_dynALL    ) THEN   ;   ioptio = ioptio + 1   ;   nice_dyn = np_dynALL       ;   ENDIF
@@ -292 +292 @@
          ALLOCATE( sf_icbmsk(1)%fnow(jpi,jpj,1) )
          IF( sf_icbmsk(1)%ln_tint )   ALLOCATE( sf_icbmsk(1)%fdta(jpi,jpj,1,2) )
-         IF( TRIM(sf_icbmsk(1)%clrootname) == 'NOT USED' ) sf_icbmsk(1)%fnow(:,:,1) = 0._wp   ! not used field  (set to 0)         
+         IF( TRIM(sf_icbmsk(1)%clrootname) == 'NOT USED' ) sf_icbmsk(1)%fnow(:,:,1) = 0._wp   ! not used field  (set to 0)
       ELSE
          icb_mask(:,:) = 0._wp
       ENDIF
-      !                                      !--- other init 
+      !                                      !--- other init
       CALL ice_dyn_rdgrft_init          ! set ice ridging/rafting parameters
       CALL ice_dyn_rhg_init             ! set ice rheology parameters
@@ -307 +307 @@
    !!   Default option         Empty module           NO SI3 sea-ice model
    !!----------------------------------------------------------------------
-#endif 
+#endif
 
    !!======================================================================

NEMO/trunk/src/ICE/icedyn_adv_pra.F90

@@ -1 @@
-MODULE icedyn_adv_pra 
+MODULE icedyn_adv_pra
    !!======================================================================
    !!                       ***  MODULE icedyn_adv_pra   ***
@@ -35 +35 @@
 
    ! Moments for advection
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxice, syice, sxxice, syyice, sxyice   ! ice thickness 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxice, syice, sxxice, syyice, sxyice   ! ice thickness
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsn , sysn , sxxsn , syysn , sxysn    ! snow thickness
    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxa  , sya  , sxxa  , syya  , sxya     ! ice concentration
@@ -59 +59 @@
       !!----------------------------------------------------------------------
       !!                **  routine ice_dyn_adv_pra  **
-      !!  
+      !!
       !! ** purpose :   Computes and adds the advection trend to sea-ice
       !!
@@ -101 +101 @@
       REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) ::   z0ei
       !! diagnostics
-      REAL(wp), DIMENSION(jpi,jpj)            ::   zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat      
+      REAL(wp), DIMENSION(jpi,jpj)            ::   zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat
       !!----------------------------------------------------------------------
       !
@@ -127 +127 @@
          ELSEWHERE                      ; ze_s(:,:,jk,:) = 0._wp
          END WHERE
-      END DO   
+      END DO
       CALL icemax4D( ze_i , zei_max )
       CALL icemax4D( ze_s , zes_max )
@@ -139 +139 @@
       zcflnow(1) =                  MAXVAL( ABS( pu_ice(:,:) ) * rDt_ice * r1_e1u(:,:) )
       zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rDt_ice * r1_e2v(:,:) ) )
-      
+
       ! non-blocking global communication send zcflnow and receive zcflprv
       CALL mpp_delay_max( 'icedyn_adv_pra', 'cflice', zcflnow(:), zcflprv(:), kt == nitend - nn_fsbc + 1 )
@@ -148 +148 @@
       zdt = rDt_ice / REAL(icycle)
       z1_dt = 1._wp / zdt
-      
+
       ! --- transport --- !
       zudy(:,:) = pu_ice(:,:) * e2u(:,:)
@@ -164 +164 @@
          ! record at_i before advection (for open water)
          zati1(:,:) = SUM( pa_i(:,:,:), dim=3 )
-         
-         ! --- transported fields --- !                                        
+
+         ! --- transported fields --- !
          DO jl = 1, jpl
             zarea(:,:,jl) = e1e2t(:,:)
@@ -209 +209 @@
             END DO
             DO jk = 1, nlay_i                                                                           !--- ice heat content
-               CALL adv_x( zdt, zudy, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
+               CALL adv_x( zdt, zudy, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   &
                   &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
-               CALL adv_y( zdt, zvdx, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
+               CALL adv_y( zdt, zvdx, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   &
                   &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
             END DO
@@ -217 +217 @@
             IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
                CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction
-               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 
+               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )
                CALL adv_x( zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume
-               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 
+               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )
                IF ( ln_pnd_lids ) THEN
                   CALL adv_x( zdt , zudy , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume
-                  CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) 
+                  CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )
                ENDIF
             ENDIF
@@ -245 +245 @@
             END DO
             DO jk = 1, nlay_i                                                                           !--- ice heat content
-               CALL adv_y( zdt, zvdx, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
+               CALL adv_y( zdt, zvdx, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   &
                   &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
-               CALL adv_x( zdt, zudy, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   & 
+               CALL adv_x( zdt, zudy, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   &
                   &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) )
             END DO
@@ -257 +257 @@
                IF ( ln_pnd_lids ) THEN
                   CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume
-                  CALL adv_x( zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) 
+                  CALL adv_x( zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )
                ENDIF
             ENDIF
             !
          ENDIF
-         
+
          ! --- Lateral boundary conditions --- !
          !     caution: for gradients (sx and sy) the sign changes
@@ -276 +276 @@
             &                                , sxxage, 'T', 1._wp, syyage, 'T',  1._wp, sxyage, 'T',  1._wp  )
          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0es  , 'T', 1._wp, sxc0  , 'T', -1._wp, syc0  , 'T', -1._wp  & ! snw enthalpy
-            &                                , sxxc0 , 'T', 1._wp, syyc0 , 'T',  1._wp, sxyc0 , 'T',  1._wp  ) 
+            &                                , sxxc0 , 'T', 1._wp, syyc0 , 'T',  1._wp, sxyc0 , 'T',  1._wp  )
          CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ei  , 'T', 1._wp, sxe   , 'T', -1._wp, sye   , 'T', -1._wp  & ! ice enthalpy
             &                                , sxxe  , 'T', 1._wp, syye  , 'T',  1._wp, sxye  , 'T',  1._wp  )
@@ -283 +283 @@
                &                                , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  &
                &                                , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume
-               &                                , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  ) 
+               &                                , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  )
             IF ( ln_pnd_lids ) THEN
                CALL lbc_lnk_multi( 'icedyn_adv_pra', z0vl ,'T', 1._wp, sxvl ,'T', -1._wp, syvl ,'T', -1._wp  & ! melt pond lid volume
-                  &                                , sxxvl,'T', 1._wp, syyvl,'T',  1._wp, sxyvl,'T',  1._wp  ) 
+                  &                                , sxxvl,'T', 1._wp, syyvl,'T',  1._wp, sxyvl,'T',  1._wp  )
             ENDIF
          ENDIF
@@ -348 +348 @@
       !
    END SUBROUTINE ice_dyn_adv_pra
-   
-   
+
+
    SUBROUTINE adv_x( pdt, put , pcrh, psm , ps0 ,   &
       &              psx, psxx, psy , psyy, psxy )
       !!----------------------------------------------------------------------
       !!                **  routine adv_x  **
-      !!  
+      !!
       !! ** purpose :   Computes and adds the advection trend to sea-ice
       !!                variable on x axis
@@ -363 +363 @@
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psm                ! area
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ps0                ! field to be advected
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psx , psy          ! 1st moments 
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psx , psy          ! 1st moments
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments
-      !! 
+      !!
       INTEGER  ::   ji, jj, jl, jcat                     ! dummy loop indices
       INTEGER  ::   jj0                                  ! dummy loop indices
@@ -386 +386 @@
       DO jl = 1, jcat   ! loop on categories
          !
-         ! Limitation of moments.                                           
+         ! Limitation of moments.
          DO jj = Njs0 - jj0, Nje0 + jj0
-            
+
             DO ji = Nis0 - 1, Nie0 + 1
 
@@ -399 +399 @@
                zpsxy = psxy(ji,jj,jl)
 
-               !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
+               !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)
                zpsm = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * zpsm , epsi20 )
                !
@@ -408 +408 @@
                rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
 
-               zps0  = zslpmax  
+               zps0  = zslpmax
                zpsx  = zs1new  * rswitch
                zpsxx = zs2new  * rswitch
@@ -415 +415 @@
                zpsxy = MIN( zslpmax, MAX( -zslpmax, zpsxy ) ) * rswitch
 
-               !  Calculate fluxes and moments between boxes i<-->i+1              
-               !                                !  Flux from i to i+1 WHEN u GT 0 
+               !  Calculate fluxes and moments between boxes i<-->i+1
+               !                                !  Flux from i to i+1 WHEN u GT 0
                zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) )
                zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / zpsm
@@ -423 +423 @@
                zalf1q       =  zalf1 * zalf1
                !
-               zfm (ji,jj)  =  zalf  *   zpsm 
+               zfm (ji,jj)  =  zalf  *   zpsm
                zf0 (ji,jj)  =  zalf  * ( zps0  + zalf1 * ( zpsx + (zalf1 - zalf) * zpsxx ) )
                zfx (ji,jj)  =  zalfq * ( zpsx  + 3.0 * zalf1 * zpsxx )
@@ -441 +441 @@
                !
                psm (ji,jj,jl) = zpsm ! optimization
-               ps0 (ji,jj,jl) = zps0 
-               psx (ji,jj,jl) = zpsx 
+               ps0 (ji,jj,jl) = zps0
+               psx (ji,jj,jl) = zpsx
                psxx(ji,jj,jl) = zpsxx
-               psy (ji,jj,jl) = zpsy 
+               psy (ji,jj,jl) = zpsy
                psyy(ji,jj,jl) = zpsyy
                psxy(ji,jj,jl) = zpsxy
                !
             END DO
-            
+
             DO ji = Nis0 - 1, Nie0
                !                                !  Flux from i+1 to i when u LT 0.
-               zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 
+               zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl)
                zalg  (ji,jj) = zalf
                zalfq         = zalf * zalf
@@ -491 +491 @@
                zpsxy = zalg1q(ji-1,jj) * zpsxy
 
-               !   Put the temporary moments into appropriate neighboring boxes.    
+               !   Put the temporary moments into appropriate neighboring boxes.
                !                                !   Flux from i to i+1 IF u GT 0.
                zbt   =       zbet(ji-1,jj)
@@ -508 +508 @@
                   &            + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * zpsy ) )  &
                   &            + zbt1 * zpsxy
-               zpsy  =  zbt  * ( zpsy  + zfy (ji-1,jj) ) + zbt1 * zpsy 
+               zpsy  =  zbt  * ( zpsy  + zfy (ji-1,jj) ) + zbt1 * zpsy
                zpsyy =  zbt  * ( zpsyy + zfyy(ji-1,jj) ) + zbt1 * zpsyy
 
@@ -530 +530 @@
                !
                psm (ji,jj,jl) = zpsm  ! optimization
-               ps0 (ji,jj,jl) = zps0 
-               psx (ji,jj,jl) = zpsx 
+               ps0 (ji,jj,jl) = zps0
+               psx (ji,jj,jl) = zpsx
                psxx(ji,jj,jl) = zpsxx
-               psy (ji,jj,jl) = zpsy 
+               psy (ji,jj,jl) = zpsy
                psyy(ji,jj,jl) = zpsyy
                psxy(ji,jj,jl) = zpsxy
@@ -541 +541 @@
          !
       END DO
-      !      
+      !
    END SUBROUTINE adv_x
 
@@ -549 +549 @@
       !!---------------------------------------------------------------------
       !!                **  routine adv_y  **
-      !!            
-      !! ** purpose :   Computes and adds the advection trend to sea-ice 
+      !!
+      !! ** purpose :   Computes and adds the advection trend to sea-ice
       !!                variable on y axis
       !!---------------------------------------------------------------------
@@ -558 +558 @@
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psm                ! area
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ps0                ! field to be advected
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psx , psy          ! 1st moments 
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psx , psy          ! 1st moments
       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments
       !!
@@ -578 +578 @@
       !
       jcat = SIZE( ps0 , 3 )   ! size of input arrays
-      !      
+      !
       DO jl = 1, jcat   ! loop on categories
          !
@@ -601 +601 @@
             rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask
             !
-            zps0  = zslpmax  
+            zps0  = zslpmax
             zpsx  = zpsx  * rswitch
             zpsxx = zpsxx * rswitch
@@ -608 +608 @@
             zpsxy = MIN( zslpmax, MAX( -zslpmax, zpsxy ) ) * rswitch
 
-            !  Calculate fluxes and moments between boxes j<-->j+1              
-            !                                !  Flux from j to j+1 WHEN v GT 0   
+            !  Calculate fluxes and moments between boxes j<-->j+1
+            !                                !  Flux from j to j+1 WHEN v GT 0
             zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) )
             zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / zpsm
@@ -617 +617 @@
             !
             zfm (ji,jj)  =  zalf  * zpsm
-            zf0 (ji,jj)  =  zalf  * ( zps0 + zalf1 * ( zpsy  + (zalf1-zalf) * zpsyy ) ) 
+            zf0 (ji,jj)  =  zalf  * ( zps0 + zalf1 * ( zpsy  + (zalf1-zalf) * zpsyy ) )
             zfy (ji,jj)  =  zalfq *( zpsy + 3.0*zalf1*zpsyy )
             zfyy(ji,jj)  =  zalf  * zalfq * zpsyy
@@ -634 +634 @@
             !
             psm (ji,jj,jl) = zpsm ! optimization
-            ps0 (ji,jj,jl) = zps0 
-            psx (ji,jj,jl) = zpsx 
+            ps0 (ji,jj,jl) = zps0
+            psx (ji,jj,jl) = zpsx
             psxx(ji,jj,jl) = zpsxx
-            psy (ji,jj,jl) = zpsy 
+            psy (ji,jj,jl) = zpsy
             psyy(ji,jj,jl) = zpsyy
             psxy(ji,jj,jl) = zpsxy
@@ -644 +644 @@
          DO_2D( 1, 0, ji0, ji0 )
             !                                !  Flux from j+1 to j when v LT 0.
-            zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 
+            zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl)
             zalg  (ji,jj) = zalf
             zalfq         = zalf * zalf
@@ -683 +683 @@
             zpsxy = zalg1q(ji,jj-1) * zpsxy
 
-            !   Put the temporary moments into appropriate neighboring boxes.    
+            !   Put the temporary moments into appropriate neighboring boxes.
             !                                !   Flux from j to j+1 IF v GT 0.
             zbt   =       zbet(ji,jj-1)
             zbt1  = 1.0 - zbet(ji,jj-1)
-            zpsm  = zbt * ( zpsm + zfm(ji,jj-1) ) + zbt1 * zpsm 
-            zalf  = zbt * zfm(ji,jj-1) / zpsm 
+            zpsm  = zbt * ( zpsm + zfm(ji,jj-1) ) + zbt1 * zpsm
+            zalf  = zbt * zfm(ji,jj-1) / zpsm
             zalf1 = 1.0 - zalf
             ztemp = zalf * zps0 - zalf1 * zf0(ji,jj-1)
@@ -694 +694 @@
             zps0  =   zbt  * ( zps0 + zf0(ji,jj-1) ) + zbt1 * zps0
             zpsy  =   zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * zpsy + 3.0 * ztemp )  &
-               &             + zbt1 * zpsy  
+               &             + zbt1 * zpsy
             zpsyy =   zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * zpsyy                           &
-               &             + 5.0 * ( zalf * zalf1 * ( zpsy - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 
+               &             + 5.0 * ( zalf * zalf1 * ( zpsy - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) &
                &             + zbt1 * zpsyy
             zpsxy =   zbt  * ( zalf * zfxy(ji,jj-1) + zalf1 * zpsxy             &
                &             + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * zpsx ) )  &
                &             + zbt1 * zpsxy
-            zpsx  =   zbt * ( zpsx  + zfx (ji,jj-1) ) + zbt1 * zpsx 
+            zpsx  =   zbt * ( zpsx  + zfx (ji,jj-1) ) + zbt1 * zpsx
             zpsxx =   zbt * ( zpsxx + zfxx(ji,jj-1) ) + zbt1 * zpsxx
 
@@ -723 +723 @@
             !
             psm (ji,jj,jl) = zpsm ! optimization
-            ps0 (ji,jj,jl) = zps0 
-            psx (ji,jj,jl) = zpsx 
+            ps0 (ji,jj,jl) = zps0
+            psx (ji,jj,jl) = zpsx
             psxx(ji,jj,jl) = zpsxx
-            psy (ji,jj,jl) = zpsy 
+            psy (ji,jj,jl) = zpsy
             psyy(ji,jj,jl) = zpsyy
             psxy(ji,jj,jl) = zpsxy
@@ -796 +796 @@
                   pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
                   pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl)
-               ENDIF           
-               !                  
+               ENDIF
+               !
                !                               ! -- check s_i -- !
                ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean
@@ -809 +809 @@
             ENDIF
          END_2D
-      END DO 
+      END DO
       !
       !                                           ! -- check e_i/v_i -- !
@@ -899 +899 @@
       !!                  ***  ROUTINE adv_pra_init  ***
       !!
-      !! ** Purpose :   allocate and initialize arrays for Prather advection 
+      !! ** Purpose :   allocate and initialize arrays for Prather advection
       !!-------------------------------------------------------------------
       INTEGER ::   ierr
@@ -932 +932 @@
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE adv_pra_rst  ***
-      !!                     
+      !!
       !! ** Purpose :   Read or write file in restart file
       !!
@@ -991 +991 @@
             DO jk = 1, nlay_s
                WRITE(zchar1,'(I2.2)') jk
-               znam = 'sxc0'//'_l'//zchar1  
+               znam = 'sxc0'//'_l'//zchar1
                CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp )   ;   sxc0 (:,:,jk,:) = z3d(:,:,:)
-               znam = 'syc0'//'_l'//zchar1  
+               znam = 'syc0'//'_l'//zchar1
                CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp )   ;   syc0 (:,:,jk,:) = z3d(:,:,:)
-               znam = 'sxxc0'//'_l'//zchar1 
+               znam = 'sxxc0'//'_l'//zchar1
                CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   sxxc0(:,:,jk,:) = z3d(:,:,:)
-               znam = 'syyc0'//'_l'//zchar1 
+               znam = 'syyc0'//'_l'//zchar1
                CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   syyc0(:,:,jk,:) = z3d(:,:,:)
-               znam = 'sxyc0'//'_l'//zchar1 
+               znam = 'sxyc0'//'_l'//zchar1
                CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   sxyc0(:,:,jk,:) = z3d(:,:,:)
             END DO
@@ -1005 +1005 @@
             DO jk = 1, nlay_i
                WRITE(zchar1,'(I2.2)') jk
-               znam = 'sxe'//'_l'//zchar1   
+               znam = 'sxe'//'_l'//zchar1
                CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp )   ;   sxe (:,:,jk,:) = z3d(:,:,:)
-               znam = 'sye'//'_l'//zchar1   
+               znam = 'sye'//'_l'//zchar1
                CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp )   ;   sye (:,:,jk,:) = z3d(:,:,:)
-               znam = 'sxxe'//'_l'//zchar1  
+               znam = 'sxxe'//'_l'//zchar1
                CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   sxxe(:,:,jk,:) = z3d(:,:,:)
-               znam = 'syye'//'_l'//zchar1  
+               znam = 'syye'//'_l'//zchar1
                CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   syye(:,:,jk,:) = z3d(:,:,:)
-               znam = 'sxye'//'_l'//zchar1  
+               znam = 'sxye'//'_l'//zchar1
                CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   sxye(:,:,jk,:) = z3d(:,:,:)
             END DO
@@ -1165 +1165 @@
    SUBROUTINE icemax3D( pice , pmax )
       !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE icemax3D ***                     
+      !!                   ***  ROUTINE icemax3D ***
       !! ** Purpose :  compute the max of the 9 points around
       !!----------------------------------------------------------------------
@@ -1174 +1174 @@
       !!----------------------------------------------------------------------
       DO jl = 1, jpl
-         DO jj = Njs0-1, Nje0+1    
+         DO jj = Njs0-1, Nje0+1
             DO ji = Nis0, Nie0
                zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) )
             END DO
          END DO
-         DO jj = Njs0, Nje0    
+         DO jj = Njs0, Nje0
             DO ji = Nis0, Nie0
                pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) )
@@ -1189 +1189 @@
    SUBROUTINE icemax4D( pice , pmax )
       !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE icemax4D ***                     
+      !!                   ***  ROUTINE icemax4D ***
       !! ** Purpose :  compute the max of the 9 points around
       !!----------------------------------------------------------------------
@@ -1200 +1200 @@
       DO jl = 1, jpl
          DO jk = 1, jlay
-            DO jj = Njs0-1, Nje0+1    
+            DO jj = Njs0-1, Nje0+1
                DO ji = Nis0, Nie0
                   zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) )
                END DO
             END DO
-            DO jj = Njs0, Nje0    
+            DO jj = Njs0, Nje0
                DO ji = Nis0, Nie0
                   pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) )

NEMO/trunk/src/ICE/icedyn_adv_umx.F90

@@ -14 +14 @@
    !!   ultimate_x(_y)    : compute a tracer value at velocity points using ULTIMATE scheme at various orders
    !!   macho             : compute the fluxes
-   !!   nonosc_ice        : limit the fluxes using a non-oscillatory algorithm 
+   !!   nonosc_ice        : limit the fluxes using a non-oscillatory algorithm
    !!----------------------------------------------------------------------
    USE phycst         ! physical constant
@@ -63 +63 @@
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ice_dyn_adv_umx  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!
+      !! **  Purpose :   Compute the now trend due to total advection of
       !!                 tracers and add it to the general trend of tracer equations
       !!                 using an "Ultimate-Macho" scheme
       !!
-      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
+      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74.
       !!----------------------------------------------------------------------
       INTEGER                     , INTENT(in   ) ::   kn_umx     ! order of the scheme (1-5=UM or 20=CEN2)
@@ -103 +103 @@
       REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) ::   ze_s, zes_max
       !
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs
       !! diagnostics
-      REAL(wp), DIMENSION(jpi,jpj)            ::   zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat      
+      REAL(wp), DIMENSION(jpi,jpj)            ::   zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat
       !!----------------------------------------------------------------------
       !
@@ -131 +131 @@
          ELSEWHERE                      ; ze_s(:,:,jk,:) = 0._wp
          END WHERE
-      END DO   
+      END DO
       CALL icemax4D( ze_i , zei_max )
       CALL icemax4D( ze_s , zes_max )
@@ -143 +143 @@
       zcflnow(1) =                  MAXVAL( ABS( pu_ice(:,:) ) * rDt_ice * r1_e1u(:,:) )
       zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rDt_ice * r1_e2v(:,:) ) )
-      
+
       ! non-blocking global communication send zcflnow and receive zcflprv
       CALL mpp_delay_max( 'icedyn_adv_umx', 'cflice', zcflnow(:), zcflprv(:), kt == nitend - nn_fsbc + 1 )
@@ -157 +157 @@
       zvdx(:,:) = pv_ice(:,:) * e1v(:,:)
       !
-      ! setup transport for each ice cat 
+      ! setup transport for each ice cat
       DO jl = 1, jpl
          zu_cat(:,:,jl) = zudy(:,:)
@@ -190 +190 @@
          ! record at_i before advection (for open water)
          zati1(:,:) = SUM( pa_i(:,:,:), dim=3 )
-         
+
          ! inverse of A and Ap
          WHERE( pa_i(:,:,:) >= epsi20 )   ;   z1_ai(:,:,:) = 1._wp / pa_i(:,:,:)
@@ -201 +201 @@
          ! setup a mask where advection will be upstream
          IF( ll_neg ) THEN
-            IF( .NOT. ALLOCATED(imsk_small) )   ALLOCATE( imsk_small(jpi,jpj,jpl) ) 
-            IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 
+            IF( .NOT. ALLOCATED(imsk_small) )   ALLOCATE( imsk_small(jpi,jpj,jpl) )
+            IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) )
             DO jl = 1, jpl
                DO_2D( 1, 0, 1, 0 )
@@ -232 +232 @@
             CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, &
                &                                      zhvar, pv_i, zua_ups, zva_ups )
-            !== Snw volume ==!         
+            !== Snw volume ==!
             zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:)
             CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, &
@@ -260 +260 @@
             CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, &
                &                                      zhvar, pv_i, zua_ups, zva_ups )
-            !== Snw volume ==!         
+            !== Snw volume ==!
             zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:)
             CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, &
@@ -316 +316 @@
                   &                                      zhvar, pe_i(:,:,jk,:), zuv_ups, zvv_ups )
             END DO
-            !== Snow volume ==!         
+            !== Snow volume ==!
             zuv_ups = zua_ups
             zvv_ups = zva_ups
@@ -374 +374 @@
          zati2(:,:) = SUM( pa_i(:,:,:), dim=3 )
          DO_2D( 0, 0, 0, 0 )
-            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 
+            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &
                &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt
          END_2D
@@ -406 +406 @@
    END SUBROUTINE ice_dyn_adv_umx
 
-   
+
    SUBROUTINE adv_umx( pamsk, kn_umx, jt, kt, pdt, pu, pv, puc, pvc, pubox, pvbox,  &
       &                                            pt, ptc, pua_ups, pva_ups, pua_ho, pva_ho )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE adv_umx  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!
+      !! **  Purpose :   Compute the now trend due to total advection of
       !!                 tracers and add it to the general trend of tracer equations
       !!
@@ -434 +434 @@
       !!
       !!             in eq. c), one can solve the equation for  S (ln_advS=T), then dVS/dt = -div(uV * uS  / u)
-      !!                                                or for HS (ln_advS=F), then dVS/dt = -div(uA * uHS / u) 
+      !!                                                or for HS (ln_advS=F), then dVS/dt = -div(uA * uHS / u)
       !!
       !! ** Note : - this method can lead to tiny negative V (-1.e-20) => set it to 0 while conserving mass etc.
@@ -462 +462 @@
       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out), OPTIONAL ::   pua_ho, pva_ho   ! high order u*a fluxes
       !
-      INTEGER  ::   ji, jj, jl       ! dummy loop indices  
+      INTEGER  ::   ji, jj, jl       ! dummy loop indices
       REAL(wp) ::   ztra             ! local scalar
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zfu_ho , zfv_ho , zpt
@@ -468 +468 @@
       !!----------------------------------------------------------------------
       !
-      ! Upstream (_ups) fluxes 
+      ! Upstream (_ups) fluxes
       ! -----------------------
       CALL upstream( pamsk, jt, kt, pdt, pt, pu, pv, zt_ups, zfu_ups, zfv_ups )
-      
-      ! High order (_ho) fluxes 
+
+      ! High order (_ho) fluxes
       ! -----------------------
       SELECT CASE( kn_umx )
@@ -506 +506 @@
                   zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj)
                ELSE
-                  zfv_ho (ji,jj,jl) = 0._wp  
-                  zfv_ups(ji,jj,jl) = 0._wp  
+                  zfv_ho (ji,jj,jl) = 0._wp
+                  zfv_ups(ji,jj,jl) = 0._wp
                ENDIF
             END_2D
@@ -551 +551 @@
       DO jl = 1, jpl
          DO_2D( 0, 0, 0, 0 )
-            ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) )  
-            !
-            ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)               
+            ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) )
+            !
+            ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)
          END_2D
       END DO
@@ -563 +563 @@
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE upstream  ***
-      !!     
+      !!
       !! **  Purpose :   compute the upstream fluxes and upstream guess of tracer
       !!----------------------------------------------------------------------
@@ -572 +572 @@
       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt               ! tracer fields
       REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pu, pv           ! 2 ice velocity components
-      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_ups           ! upstream guess of tracer 
-      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ups, pfv_ups ! upstream fluxes 
+      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_ups           ! upstream guess of tracer
+      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ups, pfv_ups ! upstream fluxes
       !
       INTEGER  ::   ji, jj, jl    ! dummy loop indices
@@ -638 +638 @@
             !
          ENDIF
-         
+
       ENDIF
       !
@@ -655 +655 @@
    END SUBROUTINE upstream
 
-   
+
    SUBROUTINE cen2( pamsk, jt, kt, pdt, pt, pu, pv, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE cen2  ***
-      !!     
+      !!
       !! **  Purpose :   compute the high order fluxes using a centered
-      !!                 second order scheme 
+      !!                 second order scheme
       !!----------------------------------------------------------------------
       REAL(wp)                        , INTENT(in   ) ::   pamsk            ! advection of concentration (1) or other tracers (0)
@@ -669 +669 @@
       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt               ! tracer fields
       REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pu, pv           ! 2 ice velocity components
-      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt_ups           ! upstream guess of tracer 
-      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pfu_ups, pfv_ups ! upstream fluxes 
-      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho, pfv_ho   ! high order fluxes 
+      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt_ups           ! upstream guess of tracer
+      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pfu_ups, pfv_ups ! upstream fluxes
+      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho, pfv_ho   ! high order fluxes
       !
       INTEGER  ::   ji, jj, jl    ! dummy loop indices
@@ -750 +750 @@
          ENDIF
          IF( np_limiter == 1 )   CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )
-         
+
       ENDIF
-   
+
    END SUBROUTINE cen2
 
-   
+
    SUBROUTINE macho( pamsk, kn_umx, jt, kt, pdt, pt, pu, pv, pubox, pvbox, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE macho  ***
-      !!     
-      !! **  Purpose :   compute the high order fluxes using Ultimate-Macho scheme  
+      !!
+      !! **  Purpose :   compute the high order fluxes using Ultimate-Macho scheme
       !!
       !! **  Method  :   ...
       !!
-      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
+      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74.
       !!----------------------------------------------------------------------
       REAL(wp)                        , INTENT(in   ) ::   pamsk            ! advection of concentration (1) or other tracers (0)
@@ -774 +774 @@
       REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pu, pv           ! 2 ice velocity components
       REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pubox, pvbox     ! upstream velocity
-      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt_ups           ! upstream guess of tracer 
-      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pfu_ups, pfv_ups ! upstream fluxes 
-      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho, pfv_ho   ! high order fluxes 
+      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt_ups           ! upstream guess of tracer
+      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pfu_ups, pfv_ups ! upstream fluxes
+      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho, pfv_ho   ! high order fluxes
       !
       INTEGER  ::   ji, jj, jl    ! dummy loop indices
@@ -807 +807 @@
          !                                                        !--  limiter in y --!
          IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )
-         !         
+         !
          !
       ELSE                                                               !==  even ice time step:  adv_y then adv_x  ==!
@@ -821 +821 @@
                   &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) &
                   &                                                                                        * pamsk           &
-                  &                             ) * pdt ) * tmask(ji,jj,1) 
+                  &                             ) * pdt ) * tmask(ji,jj,1)
             END_2D
          END DO
@@ -845 +845 @@
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE ultimate_x  ***
-      !!     
-      !! **  Purpose :   compute tracer at u-points 
+      !!
+      !! **  Purpose :   compute tracer at u-points
       !!
       !! **  Method  :   ...
       !!
-      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
+      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74.
       !!----------------------------------------------------------------------
       REAL(wp)                        , INTENT(in   ) ::   pamsk     ! advection of concentration (1) or other tracers (0)
@@ -857 +857 @@
       REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pu        ! ice i-velocity component
       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt        ! tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_u      ! tracer at u-point 
-      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho    ! high order flux 
+      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_u      ! tracer at u-point
+      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho    ! high order flux
       !
       INTEGER  ::   ji, jj, jl             ! dummy loop indices
@@ -897 +897 @@
       !
       CASE( 1 )                                                   !==  1st order central TIM  ==! (Eq. 21)
-         !        
+         !
          DO jl = 1, jpl
             DO_2D( 0, 0, 1, 0 )
@@ -911 +911 @@
                zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj)
                pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   &
-                  &                                                            - zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
-            END_2D
-         END DO
-         !  
+                  &                                                            - zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )
+            END_2D
+         END DO
+         !
       CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24)
          !
@@ -983 +983 @@
       !
    END SUBROUTINE ultimate_x
-   
- 
+
+
    SUBROUTINE ultimate_y( pamsk, kn_umx, pdt, pt, pv, pt_v, pfv_ho )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE ultimate_y  ***
-      !!     
-      !! **  Purpose :   compute tracer at v-points 
+      !!
+      !! **  Purpose :   compute tracer at v-points
       !!
       !! **  Method  :   ...
       !!
-      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
+      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74.
       !!----------------------------------------------------------------------
       REAL(wp)                        , INTENT(in   ) ::   pamsk     ! advection of concentration (1) or other tracers (0)
@@ -1000 +1000 @@
       REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pv        ! ice j-velocity component
       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt        ! tracer fields
-      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_v      ! tracer at v-point 
-      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfv_ho    ! high order flux 
+      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_v      ! tracer at v-point
+      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfv_ho    ! high order flux
       !
       INTEGER  ::   ji, jj, jl         ! dummy loop indices
@@ -1115 +1115 @@
       !
    END SUBROUTINE ultimate_y
-     
+
 
    SUBROUTINE nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE nonosc_ice  ***
-      !!     
-      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
-      !!       scheme and the before field by a non-oscillatory algorithm 
+      !!
+      !! **  Purpose :   compute monotonic tracer fluxes from the upstream
+      !!       scheme and the before field by a non-oscillatory algorithm
       !!
       !! **  Method  :   ...
@@ -1141 +1141 @@
       !!----------------------------------------------------------------------
       zbig = 1.e+40_wp
-      
+
       ! antidiffusive flux : high order minus low order
       ! --------------------------------------------------
@@ -1157 +1157 @@
       !                                    pfu_ho
       !                           *         --->
-      !                        |      |  *   |        | 
-      !                        |      |      |    *   |    
+      !                        |      |  *   |        |
+      !                        |      |      |    *   |
       !                        |      |      |        |    *
-      !            t_ups :       i-1     i       i+1       i+2   
+      !            t_ups :       i-1     i       i+1       i+2
       IF( ll_prelim ) THEN
-         
+
          DO jl = 1, jpl
             DO_2D( 0, 0, 0, 0 )
@@ -1200 +1200 @@
       z1_dt = 1._wp / pdt
       DO jl = 1, jpl
-         
+
          DO_2D( 1, 1, 1, 1 )
             IF    ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN
@@ -1244 +1244 @@
             ! if all the points are outside ice cover
             IF( zup == -zbig )   zbetup(ji,jj,jl) = 0._wp ! zbig
-            IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0._wp ! zbig            
+            IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0._wp ! zbig
             !
          END_2D
@@ -1250 +1250 @@
       CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1.0_wp, zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign)
 
-      
+
       ! monotonic flux in the y direction
       ! ---------------------------------
@@ -1280 +1280 @@
    END SUBROUTINE nonosc_ice
 
-   
+
    SUBROUTINE limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE limiter_x  ***
-      !!     
-      !! **  Purpose :   compute flux limiter 
+      !!
+      !! **  Purpose :   compute flux limiter
       !!----------------------------------------------------------------------
       REAL(wp)                  , INTENT(in   ) ::   pdt          ! tracer time-step
@@ -1295 +1295 @@
       REAL(wp) ::   Cr, Rjm, Rj, Rjp, uCFL, zpsi, zh3, zlimiter, Rr
       INTEGER  ::   ji, jj, jl    ! dummy loop indices
-      REAL(wp), DIMENSION (jpi,jpj,jpl) ::   zslpx       ! tracer slopes 
+      REAL(wp), DIMENSION (jpi,jpj,jpl) ::   zslpx       ! tracer slopes
       !!----------------------------------------------------------------------
       !
@@ -1304 +1304 @@
       END DO
       CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp)   ! lateral boundary cond.
-      
+
       DO jl = 1, jpl
          DO_2D( 0, 0, 0, 0 )
             uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj)
-            
+
             Rjm = zslpx(ji-1,jj,jl)
             Rj  = zslpx(ji  ,jj,jl)
@@ -1319 +1319 @@
                ENDIF
 
-               zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)     
+               zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)
                IF( Rj > 0. ) THEN
                   zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)),  &
@@ -1371 +1371 @@
    END SUBROUTINE limiter_x
 
-   
+
    SUBROUTINE limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE limiter_y  ***
-      !!     
-      !! **  Purpose :   compute flux limiter 
+      !!
+      !! **  Purpose :   compute flux limiter
       !!----------------------------------------------------------------------
       REAL(wp)                   , INTENT(in   ) ::   pdt          ! tracer time-step
@@ -1386 +1386 @@
       REAL(wp) ::   Cr, Rjm, Rj, Rjp, vCFL, zpsi, zh3, zlimiter, Rr
       INTEGER  ::   ji, jj, jl    ! dummy loop indices
-      REAL(wp), DIMENSION (jpi,jpj,jpl) ::   zslpy       ! tracer slopes 
+      REAL(wp), DIMENSION (jpi,jpj,jpl) ::   zslpy       ! tracer slopes
       !!----------------------------------------------------------------------
       !
@@ -1410 +1410 @@
                ENDIF
 
-               zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)     
+               zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)
                IF( Rj > 0. ) THEN
                   zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)),  &
@@ -1524 +1524 @@
                   pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra
                   pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl)
-               ENDIF           
-               !                  
+               ENDIF
+               !
                !                               ! -- check s_i -- !
                ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean
@@ -1537 +1537 @@
             ENDIF
          END_2D
-      END DO 
+      END DO
       !
       !                                           ! -- check e_i/v_i -- !
@@ -1624 +1624 @@
    SUBROUTINE icemax3D( pice , pmax )
       !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE icemax3D ***                     
+      !!                   ***  ROUTINE icemax3D ***
       !! ** Purpose :  compute the max of the 9 points around
       !!----------------------------------------------------------------------
@@ -1633 +1633 @@
       !!----------------------------------------------------------------------
       DO jl = 1, jpl
-         DO jj = Njs0-1, Nje0+1    
+         DO jj = Njs0-1, Nje0+1
             DO ji = Nis0, Nie0
                zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) )
             END DO
          END DO
-         DO jj = Njs0, Nje0    
+         DO jj = Njs0, Nje0
             DO ji = Nis0, Nie0
                pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) )
@@ -1648 +1648 @@
    SUBROUTINE icemax4D( pice , pmax )
       !!---------------------------------------------------------------------
-      !!                   ***  ROUTINE icemax4D ***                     
+      !!                   ***  ROUTINE icemax4D ***
       !! ** Purpose :  compute the max of the 9 points around
       !!----------------------------------------------------------------------
@@ -1659 +1659 @@
       DO jl = 1, jpl
          DO jk = 1, jlay
-            DO jj = Njs0-1, Nje0+1    
+            DO jj = Njs0-1, Nje0+1
                DO ji = Nis0, Nie0
                   zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) )
                END DO
             END DO
-            DO jj = Njs0, Nje0    
+            DO jj = Njs0, Nje0
                DO ji = Nis0, Nie0
                   pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) )

NEMO/trunk/src/ICE/icedyn_rdgrft.F90

@@ -2 +2 @@
    !!======================================================================
    !!                       ***  MODULE icedyn_rdgrft ***
-   !!    sea-ice : Mechanical impact on ice thickness distribution      
+   !!    sea-ice : Mechanical impact on ice thickness distribution
    !!======================================================================
-   !! History :       !  2006-02  (M. Vancoppenolle) Original code 
+   !! History :       !  2006-02  (M. Vancoppenolle) Original code
    !!            4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
    !!----------------------------------------------------------------------
@@ -16 +16 @@
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean domain
-   USE phycst         ! physical constants (ocean directory) 
+   USE phycst         ! physical constants (ocean directory)
    USE sbc_oce , ONLY : sss_m, sst_m   ! surface boundary condition: ocean fields
    USE ice1D          ! sea-ice: thermodynamics
@@ -59 +59 @@
    LOGICAL  ::   ln_str_H79       ! ice strength parameterization (Hibler79)
    REAL(wp) ::   rn_pstar         ! determines ice strength, Hibler JPO79
-   REAL(wp) ::   rn_csrdg         ! fraction of shearing energy contributing to ridging            
+   REAL(wp) ::   rn_csrdg         ! fraction of shearing energy contributing to ridging
    LOGICAL  ::   ln_partf_lin     ! participation function linear (Thorndike et al. (1975))
    REAL(wp) ::   rn_gstar         !    fractional area of young ice contributing to ridging
    LOGICAL  ::   ln_partf_exp     ! participation function exponential (Lipscomb et al. (2007))
    REAL(wp) ::   rn_astar         !    equivalent of G* for an exponential participation function
-   LOGICAL  ::   ln_ridging       ! ridging of ice or not                        
+   LOGICAL  ::   ln_ridging       ! ridging of ice or not
    REAL(wp) ::   rn_hstar         !    thickness that determines the maximal thickness of ridged ice
    REAL(wp) ::   rn_porordg       !    initial porosity of ridges (0.3 regular value)
    REAL(wp) ::   rn_fsnwrdg       !    fractional snow loss to the ocean during ridging
    REAL(wp) ::   rn_fpndrdg       !    fractional pond loss to the ocean during ridging
-   LOGICAL  ::   ln_rafting       ! rafting of ice or not                        
-   REAL(wp) ::   rn_hraft         !    threshold thickness (m) for rafting / ridging 
+   LOGICAL  ::   ln_rafting       ! rafting of ice or not
+   REAL(wp) ::   rn_hraft         !    threshold thickness (m) for rafting / ridging
    REAL(wp) ::   rn_craft         !    coefficient for smoothness of the hyperbolic tangent in rafting
    REAL(wp) ::   rn_fsnwrft       !    fractional snow loss to the ocean during rafting
@@ -124 +124 @@
       !!                Hibler, W. D. III, 1980, MWR, 108, 1943-1973, 1980.
       !!                Rothrock, D. A., 1975: JGR, 80, 4514-4519.
-      !!                Thorndike et al., 1975, JGR, 80, 4501-4513. 
+      !!                Thorndike et al., 1975, JGR, 80, 4501-4513.
       !!                Bitz et al., JGR, 2001
       !!                Amundrud and Melling, JGR 2005
-      !!                Babko et al., JGR 2002 
+      !!                Babko et al., JGR 2002
       !!
       !!     This routine is based on CICE code and authors William H. Lipscomb,
@@ -135 +135 @@
       !!
       INTEGER  ::   ji, jj, jk, jl             ! dummy loop index
-      INTEGER  ::   iter, iterate_ridging      ! local integer 
+      INTEGER  ::   iter, iterate_ridging      ! local integer
       INTEGER  ::   ipti                       ! local integer
       REAL(wp) ::   zfac                       ! local scalar
@@ -142 +142 @@
       REAL(wp), DIMENSION(jpij) ::   zconv         ! 1D rdg_conv (if EAP rheology)
       !
-      INTEGER, PARAMETER ::   jp_itermax = 20    
+      INTEGER, PARAMETER ::   jp_itermax = 20
       !!-------------------------------------------------------------------
       ! controls
@@ -153 +153 @@
          IF(lwp) WRITE(numout,*)'ice_dyn_rdgrft: ice ridging and rafting'
          IF(lwp) WRITE(numout,*)'~~~~~~~~~~~~~~'
-      ENDIF      
+      ENDIF
 
       !--------------------------------
@@ -168 +168 @@
          ENDIF
       END_2D
-      
+
       !--------------------------------------------------------
       ! 1) Dynamical inputs (closing rate, divergence, opening)
       !--------------------------------------------------------
       IF( npti > 0 ) THEN
-        
+
          ! just needed here
          CALL tab_2d_1d( npti, nptidx(1:npti), zdelt   (1:npti)      , delta_i )
@@ -184 +184 @@
 
          DO ji = 1, npti
-            ! closing_net = rate at which open water area is removed + ice area removed by ridging 
+            ! closing_net = rate at which open water area is removed + ice area removed by ridging
             !                                                        - ice area added in new ridges
-            IF( ln_rhg_EVP .OR. ln_rhg_VP ) & 
+            IF( ln_rhg_EVP .OR. ln_rhg_VP ) &
                &               closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp )
             IF( ln_rhg_EAP )   closing_net(ji) = zconv(ji)
@@ -225 +225 @@
       !-----------------
       IF( npti > 0 ) THEN
-         
+
          CALL ice_dyn_1d2d( 1 )            ! --- Move to 1D arrays --- !
 
          iter            = 1
-         iterate_ridging = 1      
+         iterate_ridging = 1
          !                                                        !----------------------!
          DO WHILE( iterate_ridging > 0 .AND. iter < jp_itermax )  !  ridging iterations  !
@@ -268 +268 @@
 
       ENDIF
-   
-      CALL ice_var_agg( 1 ) 
+
+      CALL ice_var_agg( 1 )
 
       ! controls
@@ -287 +287 @@
       !! ** Purpose :   preparation for ridging calculations
       !!
-      !! ** Method  :   Compute the thickness distribution of the ice and open water 
+      !! ** Method  :   Compute the thickness distribution of the ice and open water
       !!                participating in ridging and of the resulting ridges.
       !!-------------------------------------------------------------------
-      REAL(wp), DIMENSION(:)  , INTENT(in) ::   pato_i, pclosing_net 
-      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pa_i, pv_i 
+      REAL(wp), DIMENSION(:)  , INTENT(in) ::   pato_i, pclosing_net
+      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pa_i, pv_i
       !!
       INTEGER  ::   ji, jl                     ! dummy loop indices
       REAL(wp) ::   z1_gstar, z1_astar, zhmean, zfac   ! local scalar
-      REAL(wp), DIMENSION(jpij)        ::   zasum, z1_asum, zaksum   ! sum of a_i+ato_i and reverse 
+      REAL(wp), DIMENSION(jpij)        ::   zasum, z1_asum, zaksum   ! sum of a_i+ato_i and reverse
       REAL(wp), DIMENSION(jpij,jpl)    ::   zhi                      ! ice thickness
       REAL(wp), DIMENSION(jpij,-1:jpl) ::   zGsum                    ! zGsum(n) = sum of areas in categories 0 to n
@@ -321 +321 @@
       ! This is analogous to
       !   a(h) = b(h)g(h) as defined in Thorndike et al. (1975).
-      !   assuming b(h) = (2/Gstar) * (1 - G(h)/Gstar). 
+      !   assuming b(h) = (2/Gstar) * (1 - G(h)/Gstar).
       !
       ! apartf = integrating b(h)g(h) between the category boundaries
@@ -346 +346 @@
       !
       IF( ln_partf_lin ) THEN          !--- Linear formulation (Thorndike et al., 1975)
-         DO jl = 0, jpl    
+         DO jl = 0, jpl
             DO ji = 1, npti
                IF    ( zGsum(ji,jl)   < rn_gstar ) THEN
@@ -361 +361 @@
          !
       ELSEIF( ln_partf_exp ) THEN      !--- Exponential, more stable formulation (Lipscomb et al, 2007)
-         !                        
+         !
          zfac = 1._wp / ( 1._wp - EXP(-z1_astar) )
          DO jl = -1, jpl
@@ -391 +391 @@
             END DO
          END DO
-      ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN   !- rafting alone   
+      ELSEIF( ln_rafting .AND. .NOT. ln_ridging ) THEN   !- rafting alone
          DO jl = 1, jpl
             DO ji = 1, npti
@@ -402 +402 @@
             DO ji = 1, npti
                aridge(ji,jl) = 0._wp
-               araft (ji,jl) = 0._wp         
+               araft (ji,jl) = 0._wp
             END DO
          END DO
@@ -411 +411 @@
       ! Compute max and min ridged ice thickness for each ridging category.
       ! Assume ridged ice is uniformly distributed between hrmin and hrmax.
-      ! 
+      !
       ! This parameterization is a modified version of Hibler (1980).
       ! The mean ridging thickness, zhmean, is proportional to hi^(0.5)
       !  and for very thick ridging ice must be >= hrdg_hi_min*hi
       !
-      ! The minimum ridging thickness, hrmin, is equal to 2*hi 
+      ! The minimum ridging thickness, hrmin, is equal to 2*hi
       !  (i.e., rafting) and for very thick ridging ice is
       !  constrained by hrmin <= (zhmean + hi)/2.
-      ! 
+      !
       ! The maximum ridging thickness, hrmax, is determined by zhmean and hrmin.
       !
@@ -445 +445 @@
                   &                    + araft (ji,jl) * ( 1._wp - hi_hrft )
             ELSE
-               hrmin  (ji,jl) = 0._wp 
-               hrmax  (ji,jl) = 0._wp 
-               hraft  (ji,jl) = 0._wp 
+               hrmin  (ji,jl) = 0._wp
+               hrmax  (ji,jl) = 0._wp
+               hraft  (ji,jl) = 0._wp
                hi_hrdg(ji,jl) = 1._wp
             ENDIF
@@ -455 +455 @@
       ! 3) closing_gross
       !-----------------
-      ! Based on the ITD of ridging and ridged ice, convert the net closing rate to a gross closing rate.  
+      ! Based on the ITD of ridging and ridged ice, convert the net closing rate to a gross closing rate.
       ! NOTE: 0 < aksum <= 1
       WHERE( zaksum(1:npti) > epsi10 )   ;   closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti)
       ELSEWHERE                          ;   closing_gross(1:npti) = 0._wp
       END WHERE
-      
+
       ! correction to closing rate if excessive ice removal
       !----------------------------------------------------
@@ -472 +472 @@
             ENDIF
          END DO
-      END DO      
+      END DO
 
       ! 4) correction to opening if excessive open water removal
@@ -478 +478 @@
       ! Reduce the closing rate if more than 100% of the open water would be removed
       ! Reduce the opening rate in proportion
-      DO ji = 1, npti  
+      DO ji = 1, npti
          zfac = pato_i(ji) + ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rDt_ice
          IF( zfac < 0._wp ) THEN           ! would lead to negative ato_i
-            opning(ji) = apartf(ji,0) * closing_gross(ji) - pato_i(ji) * r1_Dt_ice 
+            opning(ji) = apartf(ji,0) * closing_gross(ji) - pato_i(ji) * r1_Dt_ice
          ELSEIF( zfac > zasum(ji) ) THEN   ! would lead to ato_i > asum
-            opning(ji) = apartf(ji,0) * closing_gross(ji) + ( zasum(ji) - pato_i(ji) ) * r1_Dt_ice 
+            opning(ji) = apartf(ji,0) * closing_gross(ji) + ( zasum(ji) - pato_i(ji) ) * r1_Dt_ice
          ENDIF
       END DO
@@ -503 +503 @@
       REAL(wp) ::   hL, hR, farea              ! left and right limits of integration and new area going to jl2
       REAL(wp) ::   vsw                        ! vol of water trapped into ridges
-      REAL(wp) ::   afrdg, afrft               ! fraction of category area ridged/rafted 
+      REAL(wp) ::   afrdg, afrft               ! fraction of category area ridged/rafted
       REAL(wp)                  ::   airdg1, oirdg1, aprdg1, virdg1, sirdg1
       REAL(wp)                  ::   airft1, oirft1, aprft1
@@ -516 +516 @@
       REAL(wp), DIMENSION(jpij,nlay_s) ::   esrft     ! snow energy of rafting ice
       REAL(wp), DIMENSION(jpij,nlay_i) ::   eirft     ! ice  energy of rafting ice
-      REAL(wp), DIMENSION(jpij,nlay_s) ::   esrdg     ! enth*volume of new ridges      
+      REAL(wp), DIMENSION(jpij,nlay_s) ::   esrdg     ! enth*volume of new ridges
       REAL(wp), DIMENSION(jpij,nlay_i) ::   eirdg     ! enth*volume of new ridges
       !
@@ -529 +529 @@
          ato_i_1d(ji) = MAX( 0._wp, ato_i_1d(ji) + ( opning(ji) - apartf(ji,0) * closing_gross(ji) ) * rDt_ice )
       END DO
-      
-      ! 2) compute categories in which ice is removed (jl1) 
+
+      ! 2) compute categories in which ice is removed (jl1)
       !----------------------------------------------------
       DO jl1 = 1, jpl
 
-         IF( nn_icesal /= 2 )  THEN      
+         IF( nn_icesal /= 2 )  THEN
             CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,jl1) )
          ENDIF
@@ -545 +545 @@
                ELSE                                 ;   z1_ai(ji) = 0._wp
                ENDIF
-               
+
                ! area of ridging / rafting ice (airdg1) and of new ridge (airdg2)
                airdg1 = aridge(ji,jl1) * closing_gross(ji) * rDt_ice
@@ -571 +571 @@
                sirdg2(ji) = sv_i_2d(ji,jl1)   * afrdg + vsw * sss_1d(ji)
                oirdg1     = oa_i_2d(ji,jl1)   * afrdg
-               oirdg2(ji) = oa_i_2d(ji,jl1)   * afrdg * hi_hrdg(ji,jl1) 
+               oirdg2(ji) = oa_i_2d(ji,jl1)   * afrdg * hi_hrdg(ji,jl1)
 
                virft(ji)  = v_i_2d (ji,jl1)   * afrft
                vsrft(ji)  = v_s_2d (ji,jl1)   * afrft
-               sirft(ji)  = sv_i_2d(ji,jl1)   * afrft 
-               oirft1     = oa_i_2d(ji,jl1)   * afrft 
-               oirft2(ji) = oa_i_2d(ji,jl1)   * afrft * hi_hrft 
+               sirft(ji)  = sv_i_2d(ji,jl1)   * afrft
+               oirft1     = oa_i_2d(ji,jl1)   * afrft
+               oirft2(ji) = oa_i_2d(ji,jl1)   * afrft * hi_hrft
 
                IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
@@ -595 +595 @@
                wfx_dyn_1d(ji) = wfx_dyn_1d(ji) - vsw * rhoi * r1_Dt_ice   ! increase in ice volume due to seawater frozen in voids
                sfx_dyn_1d(ji) = sfx_dyn_1d(ji) - vsw * sss_1d(ji) * rhoi * r1_Dt_ice
-               hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ersw(ji) * r1_Dt_ice          ! > 0 [W.m-2] 
+               hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ersw(ji) * r1_Dt_ice          ! > 0 [W.m-2]
 
                ! Put the snow lost by ridging into the ocean
@@ -606 +606 @@
                   sirdg2(ji)     = sirdg2(ji)     - vsw * ( sss_1d(ji) - s_i_1d(ji) )       ! ridge salinity = s_i
                   sfx_bri_1d(ji) = sfx_bri_1d(ji) + sss_1d(ji) * vsw * rhoi * r1_Dt_ice  &  ! put back sss_m into the ocean
-                     &                            - s_i_1d(ji) * vsw * rhoi * r1_Dt_ice     ! and get  s_i  from the ocean 
+                     &                            - s_i_1d(ji) * vsw * rhoi * r1_Dt_ice     ! and get  s_i  from the ocean
                ENDIF
 
@@ -643 +643 @@
                   ! Remove energy of new ridge to each category jl1
                   !-------------------------------------------------
-                  ze_s_2d(ji,jk,jl1) = ze_s_2d(ji,jk,jl1) * ( 1._wp - afrdg - afrft ) 
+                  ze_s_2d(ji,jk,jl1) = ze_s_2d(ji,jk,jl1) * ( 1._wp - afrdg - afrft )
                ENDIF
             END DO
          END DO
-                  
+
          ! special loop for e_i because of layers jk
          DO jk = 1, nlay_i
@@ -661 +661 @@
                   ! Remove energy of new ridge to each category jl1
                   !-------------------------------------------------
-                  ze_i_2d(ji,jk,jl1) = ze_i_2d(ji,jk,jl1) * ( 1._wp - afrdg - afrft ) 
+                  ze_i_2d(ji,jk,jl1) = ze_i_2d(ji,jk,jl1) * ( 1._wp - afrdg - afrft )
                ENDIF
             END DO
          END DO
-         
-         ! 3) compute categories in which ice is added (jl2) 
+
+         ! 3) compute categories in which ice is added (jl2)
          !--------------------------------------------------
          itest_rdg(1:npti) = 0
          itest_rft(1:npti) = 0
-         DO jl2  = 1, jpl 
+         DO jl2  = 1, jpl
             !
             DO ji = 1, npti
@@ -685 +685 @@
                      itest_rdg(ji) = 1   ! test for conservation
                   ELSE
-                     farea    = 0._wp 
-                     fvol(ji) = 0._wp                  
+                     farea    = 0._wp
+                     fvol(ji) = 0._wp
                   ENDIF
 
@@ -701 +701 @@
                   ! Sometimes thickness is larger than hi_max(jpl) because of advection scheme (for very small areas)
                   ! Then ice volume is removed from one category but the ridging/rafting scheme
-                  ! does not know where to move it, leading to a conservation issue.  
+                  ! does not know where to move it, leading to a conservation issue.
                   IF( itest_rdg(ji) == 0 .AND. jl2 == jpl ) THEN   ;   farea = 1._wp   ;   fvol(ji) = 1._wp   ;   ENDIF
                   IF( itest_rft(ji) == 0 .AND. jl2 == jpl )      zswitch(ji) = 1._wp
@@ -716 +716 @@
                      v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + (   vprdg (ji) * rn_fpndrdg * fvol   (ji)   &
                         &                                   + vprft (ji) * rn_fpndrft * zswitch(ji)   )
-                     a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + (   aprdg2(ji) * rn_fpndrdg * farea         & 
+                     a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + (   aprdg2(ji) * rn_fpndrdg * farea         &
                         &                                   + aprft2(ji) * rn_fpndrft * zswitch(ji)   )
                      IF ( ln_pnd_lids ) THEN
@@ -723 +723 @@
                      ENDIF
                   ENDIF
-                  
+
                ENDIF
 
@@ -741 +741 @@
                DO ji = 1, npti
                   IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp )   &
-                     &   ze_i_2d(ji,jk,jl2) = ze_i_2d(ji,jk,jl2) + eirdg(ji,jk) * fvol(ji) + eirft(ji,jk) * zswitch(ji)                  
+                     &   ze_i_2d(ji,jk,jl2) = ze_i_2d(ji,jk,jl2) + eirdg(ji,jk) * fvol(ji) + eirft(ji,jk) * zswitch(ji)
                END DO
             END DO
@@ -763 +763 @@
       !! ** Purpose :   computes ice strength used in dynamics routines of ice thickness
       !!
-      !! ** Method  :   Compute the strength of the ice pack, defined as the energy (J m-2) 
+      !! ** Method  :   Compute the strength of the ice pack, defined as the energy (J m-2)
       !!              dissipated per unit area removed from the ice pack under compression,
       !!              and assumed proportional to the change in potential energy caused
@@ -793 +793 @@
       CASE( 1 )               !--- Spatial smoothing
          DO_2D( 0, 0, 0, 0 )
-            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
+            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN
                zworka(ji,jj) = ( 4.0 * strength(ji,jj)              &
-                  &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &  
+                  &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &
                   &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) &
                   &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) )
@@ -802 +802 @@
             ENDIF
          END_2D
-         
+
          DO_2D( 0, 0, 0, 0 )
             strength(ji,jj) = zworka(ji,jj)
@@ -815 +815 @@
          !
          DO_2D( 0, 0, 0, 0 )
-            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 
+            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN
                itframe = 1 ! number of time steps for the running mean
                IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1
@@ -831 +831 @@
    END SUBROUTINE ice_strength
 
-   
+
    SUBROUTINE ice_dyn_1d2d( kn )
       !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE ice_dyn_1d2d *** 
-      !!                 
+      !!                   ***  ROUTINE ice_dyn_1d2d ***
+      !!
       !! ** Purpose :   move arrays from 1d to 2d and the reverse
       !!-----------------------------------------------------------------------
@@ -905 +905 @@
       !
    END SUBROUTINE ice_dyn_1d2d
-   
+
 
    SUBROUTINE ice_dyn_rdgrft_init
@@ -911 +911 @@
       !!                  ***  ROUTINE ice_dyn_rdgrft_init ***
       !!
-      !! ** Purpose :   Physical constants and parameters linked 
+      !! ** Purpose :   Physical constants and parameters linked
       !!                to the mechanical ice redistribution
       !!
-      !! ** Method  :   Read the namdyn_rdgrft namelist 
-      !!                and check the parameters values 
+      !! ** Method  :   Read the namdyn_rdgrft namelist
+      !!                and check the parameters values
       !!                called at the first timestep (nit000)
       !!
@@ -925 +925 @@
          &                    rn_csrdg  ,                    &
          &                    ln_partf_lin, rn_gstar,        &
-         &                    ln_partf_exp, rn_astar,        & 
-         &                    ln_ridging, rn_hstar, rn_porordg, rn_fsnwrdg, rn_fpndrdg,  & 
+         &                    ln_partf_exp, rn_astar,        &
+         &                    ln_ridging, rn_hstar, rn_porordg, rn_fsnwrdg, rn_fpndrdg,  &
          &                    ln_rafting, rn_hraft, rn_craft  , rn_fsnwrft, rn_fpndrft
       !!-------------------------------------------------------------------
@@ -941 +941 @@
          WRITE(numout,*) '~~~~~~~~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namdyn_rdgrft:'
-         WRITE(numout,*) '      ice strength parameterization Hibler (1979)              ln_str_H79   = ', ln_str_H79 
+         WRITE(numout,*) '      ice strength parameterization Hibler (1979)              ln_str_H79   = ', ln_str_H79
          WRITE(numout,*) '            1st bulk-rheology parameter                        rn_pstar     = ', rn_pstar
          WRITE(numout,*) '            2nd bulk-rhelogy parameter                         rn_crhg      = ', rn_crhg
-         WRITE(numout,*) '      Fraction of shear energy contributing to ridging         rn_csrdg     = ', rn_csrdg 
+         WRITE(numout,*) '      Fraction of shear energy contributing to ridging         rn_csrdg     = ', rn_csrdg
          WRITE(numout,*) '      linear ridging participation function                    ln_partf_lin = ', ln_partf_lin
          WRITE(numout,*) '            Fraction of ice coverage contributing to ridging   rn_gstar     = ', rn_gstar
@@ -952 +952 @@
          WRITE(numout,*) '            max ridged ice thickness                           rn_hstar     = ', rn_hstar
          WRITE(numout,*) '            Initial porosity of ridges                         rn_porordg   = ', rn_porordg
-         WRITE(numout,*) '            Fraction of snow volume conserved during ridging   rn_fsnwrdg   = ', rn_fsnwrdg 
-         WRITE(numout,*) '            Fraction of pond volume conserved during ridging   rn_fpndrdg   = ', rn_fpndrdg 
+         WRITE(numout,*) '            Fraction of snow volume conserved during ridging   rn_fsnwrdg   = ', rn_fsnwrdg
+         WRITE(numout,*) '            Fraction of pond volume conserved during ridging   rn_fpndrdg   = ', rn_fpndrdg
          WRITE(numout,*) '      Rafting of ice sheets or not                             ln_rafting   = ', ln_rafting
          WRITE(numout,*) '            Parmeter thickness (threshold between ridge-raft)  rn_hraft     = ', rn_hraft
-         WRITE(numout,*) '            Rafting hyperbolic tangent coefficient             rn_craft     = ', rn_craft  
-         WRITE(numout,*) '            Fraction of snow volume conserved during rafting   rn_fsnwrft   = ', rn_fsnwrft 
-         WRITE(numout,*) '            Fraction of pond volume conserved during rafting   rn_fpndrft   = ', rn_fpndrft 
+         WRITE(numout,*) '            Rafting hyperbolic tangent coefficient             rn_craft     = ', rn_craft
+         WRITE(numout,*) '            Fraction of snow volume conserved during rafting   rn_fsnwrft   = ', rn_fsnwrft
+         WRITE(numout,*) '            Fraction of pond volume conserved during rafting   rn_fpndrft   = ', rn_fpndrft
       ENDIF
       !
@@ -972 +972 @@
             WRITE(numout,*) '      ==> only ice dynamics is activated, thus some parameters must be changed'
             WRITE(numout,*) '            rn_porordg   = ', rn_porordg
-            WRITE(numout,*) '            rn_fsnwrdg   = ', rn_fsnwrdg 
-            WRITE(numout,*) '            rn_fpndrdg   = ', rn_fpndrdg 
-            WRITE(numout,*) '            rn_fsnwrft   = ', rn_fsnwrft 
-            WRITE(numout,*) '            rn_fpndrft   = ', rn_fpndrft 
+            WRITE(numout,*) '            rn_fsnwrdg   = ', rn_fsnwrdg
+            WRITE(numout,*) '            rn_fpndrdg   = ', rn_fpndrdg
+            WRITE(numout,*) '            rn_fsnwrft   = ', rn_fsnwrft
+            WRITE(numout,*) '            rn_fpndrft   = ', rn_fpndrft
          ENDIF
       ENDIF

NEMO/trunk/src/ICE/icedyn_rhg.F90

@@ -2 +2 @@
    !!======================================================================
    !!                     ***  MODULE  icedyn_rhg  ***
-   !!   Sea-Ice dynamics : master routine for rheology 
+   !!   Sea-Ice dynamics : master routine for rheology
    !!======================================================================
    !! history :  4.0  !  2018     (C. Rousset)      Original code
@@ -49 +49 @@
       !!-------------------------------------------------------------------
       !!               ***  ROUTINE ice_dyn_rhg  ***
-      !!               
+      !!
       !! ** Purpose :   compute ice velocity
       !!
@@ -72 +72 @@
       !--------------!
       !== Rheology ==!
-      !--------------!   
+      !--------------!
       SELECT CASE( nice_rhg )
       !                                !------------------------!
@@ -78 +78 @@
          !                             !------------------------!
          CALL ice_dyn_rhg_evp( kt, Kmm, stress1_i, stress2_i, stress12_i, shear_i, divu_i, delta_i )
-         !        
+         !
          !                             !------------------------!
       CASE( np_rhgVP  )                ! Viscous-Plastic        !
@@ -121 +121 @@
       !!
       NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, ln_rhg_EAP, rn_creepl, rn_ecc , nn_nevp, rn_relast, nn_rhg_chkcvg, &  !-- evp
-         &                  ln_rhg_VP, nn_vp_nout, nn_vp_ninn, nn_vp_chkcvg                                            !-- vp 
+         &                  ln_rhg_VP, nn_vp_nout, nn_vp_ninn, nn_vp_chkcvg                                            !-- vp
       !!-------------------------------------------------------------------
       !
@@ -156 +156 @@
       !
       !                             !== set the choice of ice advection ==!
-      ioptio = 0 
+      ioptio = 0
       IF( ln_rhg_EVP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEVP    ;   ENDIF
       IF( ln_rhg_EAP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEAP    ;   ENDIF
-      IF( ln_rhg_VP  ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgVP     ;   ENDIF 
+      IF( ln_rhg_VP  ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgVP     ;   ENDIF
       IF( ioptio /= 1 )   CALL ctl_stop( 'ice_dyn_rhg_init: choose one and only one ice rheology' )
       !
@@ -172 +172 @@
    !!   Default option         Empty module           NO SI3 sea-ice model
    !!----------------------------------------------------------------------
-#endif 
+#endif
 
    !!======================================================================

NEMO/trunk/src/ICE/icedyn_rhg_evp.F90

@@ -6 +6 @@
    !! History :   -   !  2007-03  (M.A. Morales Maqueda, S. Bouillon) Original code
    !!            3.0  !  2008-03  (M. Vancoppenolle) adaptation to new model
-   !!             -   !  2008-11  (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy 
+   !!             -   !  2008-11  (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy
    !!            3.3  !  2009-05  (G.Garric)    addition of the evp case
-   !!            3.4  !  2011-01  (A. Porter)   dynamical allocation 
+   !!            3.4  !  2011-01  (A. Porter)   dynamical allocation
    !!            3.5  !  2012-08  (R. Benshila) AGRIF
    !!            3.6  !  2016-06  (C. Rousset)  Rewriting + landfast ice + mEVP (Bouillon 2013)
@@ -28 +28 @@
    USE icevar         ! ice_var_sshdyn
    USE icedyn_rdgrft  ! sea-ice: ice strength
-   USE bdy_oce , ONLY : ln_bdy 
-   USE bdyice 
+   USE bdy_oce , ONLY : ln_bdy
+   USE bdyice
 #if defined key_agrif
    USE agrif_ice_interp
@@ -69 +69 @@
       !!
       !! ** purpose : determines sea ice drift from wind stress, ice-ocean
-      !!  stress and sea-surface slope. Ice-ice interaction is described by 
-      !!  a non-linear elasto-viscous-plastic (EVP) law including shear 
-      !!  strength and a bulk rheology (Hunke and Dukowicz, 2002).   
+      !!  stress and sea-surface slope. Ice-ice interaction is described by
+      !!  a non-linear elasto-viscous-plastic (EVP) law including shear
+      !!  strength and a bulk rheology (Hunke and Dukowicz, 2002).
       !!
       !!  The points in the C-grid look like this, dear reader
@@ -79 +79 @@
       !!                                 |
       !!                      (ji-1,jj)  |  (ji,jj)
-      !!                             ---------   
+      !!                             ---------
       !!                            |         |
       !!                            | (ji,jj) |------(ji,jj)
       !!                            |         |
-      !!                             ---------   
+      !!                             ---------
       !!                     (ji-1,jj-1)     (ji,jj-1)
       !!
@@ -90 +90 @@
       !!                snow total volume (vt_s) per unit area
       !!
-      !! ** Action  : - compute u_ice, v_ice : the components of the 
+      !! ** Action  : - compute u_ice, v_ice : the components of the
       !!                sea-ice velocity vector
       !!              - compute delta_i, shear_i, divu_i, which are inputs
@@ -96 +96 @@
       !!
       !! ** Steps   : 0) compute mask at F point
-      !!              1) Compute ice snow mass, ice strength 
+      !!              1) Compute ice snow mass, ice strength
       !!              2) Compute wind, oceanic stresses, mass terms and
       !!                 coriolis terms of the momentum equation
@@ -152 +152 @@
       REAL(wp), DIMENSION(jpi,jpj) ::   zsshdyn                         ! array used for the calculation of ice surface slope:
       !                                                                 !    ocean surface (ssh_m) if ice is not embedded
-      !                                                                 !    ice bottom surface if ice is embedded   
+      !                                                                 !    ice bottom surface if ice is embedded
       REAL(wp), DIMENSION(jpi,jpj) ::   zfU  , zfV                      ! internal stresses
       REAL(wp), DIMENSION(jpi,jpj) ::   zspgU, zspgV                    ! surface pressure gradient at U/V points
@@ -172 +172 @@
       !! --- diags
       REAL(wp) ::   zsig1, zsig2, zsig12, zfac, z1_strength
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig_I, zsig_II, zsig1_p, zsig2_p         
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig_I, zsig_II, zsig1_p, zsig2_p
       !! --- SIMIP diags
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xmtrp_ice ! X-component of ice mass transport (kg/s)
@@ -179 +179 @@
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_ymtrp_snw ! Y-component of snow mass transport (kg/s)
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xatrp     ! X-component of area transport (m2/s)
-      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_yatrp     ! Y-component of area transport (m2/s)      
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_yatrp     ! Y-component of area transport (m2/s)
       !!-------------------------------------------------------------------
 
@@ -229 +229 @@
       ! 1) define some variables and initialize arrays
       !------------------------------------------------------------------------------!
-      zrhoco = rho0 * rn_cio 
+      zrhoco = rho0 * rn_cio
 
       ! ecc2: square of yield ellipse eccenticrity
@@ -248 +248 @@
       ENDIF
       z1_dtevp = 1._wp / zdtevp
-         
-      ! Initialise stress tensor 
-      zs1 (:,:) = pstress1_i (:,:) 
+
+      ! Initialise stress tensor
+      zs1 (:,:) = pstress1_i (:,:)
       zs2 (:,:) = pstress2_i (:,:)
       zs12(:,:) = pstress12_i(:,:)
@@ -292 +292 @@
          ! dt/m at T points (for alpha and beta coefficients)
          zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin )
-         
+
          ! m/dt
          zmU_t(ji,jj)    = zmassU * z1_dtevp
          zmV_t(ji,jj)    = zmassV * z1_dtevp
-         
+
          ! Drag ice-atm.
          ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
@@ -350 +350 @@
       !                                               ! ==================== !
       DO jter = 1 , nn_nevp                           !    loop over jter    !
-         !                                            ! ==================== !        
+         !                                            ! ==================== !
          l_full_nf_update = jter == nn_nevp   ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1
          !
@@ -377 +377 @@
                &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
                &   ) * 0.25_wp * r1_e1e2t(ji,jj)
-           
+
             ! divergence at T points
             zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   &
@@ -383 +383 @@
                &    ) * r1_e1e2t(ji,jj)
             zdiv2 = zdiv * zdiv
-            
+
             ! tension at T points
             zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
@@ -389 +389 @@
                &   ) * r1_e1e2t(ji,jj)
             zdt2 = zdt * zdt
-            
+
             ! delta at T points
-            zdelta(ji,jj) = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )  
+            zdelta(ji,jj) = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )
 
          END_2D
@@ -407 +407 @@
                &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
                &    ) * r1_e1e2t(ji,jj)
-            
+
             ! tension at T points (duplication to avoid communications)
             zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
                &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   &
                &   ) * r1_e1e2t(ji,jj)
-            
+
             ! alpha for aEVP
             !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m
@@ -427 +427 @@
                ! zalph2 = zalph1
             ENDIF
-            
+
             ! stress at T points (zkt/=0 if landfast)
             zs1(ji,jj) = ( zs1(ji,jj)*zalph1 + zp_delt(ji,jj) * ( zdiv*(1._wp + zkt) - zdelta(ji,jj)*(1._wp - zkt) ) ) * z1_alph1
             zs2(ji,jj) = ( zs2(ji,jj)*zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2
-          
+
          END_2D
 
@@ -440 +440 @@
             END_2D
          ENDIF
-         
+
          DO_2D( 1, 0, 1, 0 )
 
@@ -451 +451 @@
                ! zalph2 = zalph2 - 1._wp
             ENDIF
-            
+
             ! P/delta at F points
             zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) )
-            
+
             ! stress at F points (zkt/=0 if landfast)
             zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2
@@ -519 +519 @@
                      &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
                      &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   & 
+                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   &
                      &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
                      &                                    ) / ( zbetav + 1._wp )                                              &
@@ -574 +574 @@
                      &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
                      &                                    ) / ( zbetau + 1._wp )                                              &
-                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
-                     &           )   * zmsk00x(ji,jj)
-               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity
-                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
-                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
-                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
-                     &           )   * zmsk00x(ji,jj)
-               ENDIF
-            END_2D
-            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp )
-            !
-#if defined key_agrif
-!!            CALL agrif_interp_ice( 'U', jter, nn_nevp )
-            CALL agrif_interp_ice( 'U' )
-#endif
-            IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
-            !
-         ELSE ! odd iterations
-            !
-            DO_2D( 0, 0, 0, 0 )
-               !                 !--- tau_io/(u_oce - u_ice)
-               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
-                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
-               !                 !--- Ocean-to-Ice stress
-               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
-               !
-               !                 !--- tau_bottom/u_ice
-               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
-               zTauB = ztaux_base(ji,jj) / zvel
-               !                 !--- OceanBottom-to-Ice stress
-               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
-               !
-               !                 !--- Coriolis at U-points (energy conserving formulation)
-               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
-                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
-                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
-               !
-               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
-               !
-               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
-               !                                         1 = sliding friction : TauB < RHS
-               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
-               !
-               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) )
-                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
-                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   &
-                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
-                     &                                    ) / ( zbetau + 1._wp )                                              &
-                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
+                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
                      &           )   * zmsk00x(ji,jj)
                ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
@@ -647 +593 @@
             IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
             !
+         ELSE ! odd iterations
+            !
+            DO_2D( 0, 0, 0, 0 )
+               !                 !--- tau_io/(u_oce - u_ice)
+               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
+                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) )
+               !                 !--- Ocean-to-Ice stress
+               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )
+               !
+               !                 !--- tau_bottom/u_ice
+               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
+               zTauB = ztaux_base(ji,jj) / zvel
+               !                 !--- OceanBottom-to-Ice stress
+               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
+               !
+               !                 !--- Coriolis at U-points (energy conserving formulation)
+               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
+                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
+                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
+               !
+               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
+               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
+               !
+               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS)
+               !                                         1 = sliding friction : TauB < RHS
+               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) )
+               !
+               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
+                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) )
+                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
+                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   &
+                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
+                     &                                    ) / ( zbetau + 1._wp )                                              &
+                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &           )   * zmsk00x(ji,jj)
+               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
+                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity
+                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast
+                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0
+                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &           )   * zmsk00x(ji,jj)
+               ENDIF
+            END_2D
+            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp )
+            !
+#if defined key_agrif
+!!            CALL agrif_interp_ice( 'U', jter, nn_nevp )
+            CALL agrif_interp_ice( 'U' )
+#endif
+            IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
+            !
             DO_2D( 0, 0, 0, 0 )
                !                 !--- tau_io/(v_oce - v_ice)
@@ -679 +679 @@
                      &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   &
                      &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0
-                     &                                    ) / ( zbetav + 1._wp )                                              & 
+                     &                                    ) / ( zbetav + 1._wp )                                              &
                      &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
                      &           )   * zmsk00y(ji,jj)
@@ -710 +710 @@
       !
       !------------------------------------------------------------------------------!
-      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 
+      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution)
       !------------------------------------------------------------------------------!
       DO_2D( 1, 0, 1, 0 )
@@ -720 +720 @@
 
       END_2D
-      
+
       DO_2D( 0, 0, 0, 0 )   ! no vector loop
-         
+
          ! tension**2 at T points
          zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   &
@@ -730 +730 @@
 
          zten_i(ji,jj) = zdt
-         
+
          ! shear**2 at T points (doc eq. A16)
          zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  &
             &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  &
             &   ) * 0.25_wp * r1_e1e2t(ji,jj)
-         
+
          ! shear at T points
          pshear_i(ji,jj) = SQRT( zdt2 + zds2 )
@@ -743 +743 @@
             &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   &
             &             ) * r1_e1e2t(ji,jj)
-         
+
          ! delta at T points
-         zfac            = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) ! delta  
+         zfac            = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) ! delta
          rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zfac ) ) ! 0 if delta=0
          pdelta_i(ji,jj) = zfac + rn_creepl * rswitch ! delta+creepl
@@ -752 +752 @@
       CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1._wp, pdivu_i, 'T', 1._wp, pdelta_i, 'T', 1._wp, zten_i, 'T', 1._wp, &
          &                                  zs1     , 'T', 1._wp, zs2    , 'T', 1._wp, zs12    , 'F', 1._wp )
-      
+
       ! --- Store the stress tensor for the next time step --- !
       pstress1_i (:,:) = zs1 (:,:)
@@ -776 +776 @@
          CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 )
       ENDIF
-       
+
       ! --- divergence, shear and strength --- !
       IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * zmsk00 )   ! divergence
@@ -786 +786 @@
          !
          ALLOCATE( zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )
-         !         
+         !
          DO_2D( 1, 1, 1, 1 )
-            
+
             ! Ice stresses
             ! sigma1, sigma2, sigma12 are some useful recombination of the stresses (Hunke and Dukowicz MWR 2002, Bouillon et al., OM2013)
             ! These are NOT stress tensor components, neither stress invariants, neither stress principal components
             ! I know, this can be confusing...
-            zfac             =   strength(ji,jj) / ( pdelta_i(ji,jj) + rn_creepl ) 
+            zfac             =   strength(ji,jj) / ( pdelta_i(ji,jj) + rn_creepl )
             zsig1            =   zfac * ( pdivu_i(ji,jj) - pdelta_i(ji,jj) )
             zsig2            =   zfac * z1_ecc2 * zten_i(ji,jj)
             zsig12           =   zfac * z1_ecc2 * pshear_i(ji,jj)
-            
+
             ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008)
             zsig_I (ji,jj)   =   zsig1 * 0.5_wp                                           ! 1st stress invariant, aka average normal stress, aka negative pressure
             zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )  ! 2nd  ''       '', aka maximum shear stress
-               
-         END_2D         
+
+         END_2D
          !
          ! Stress tensor invariants (normal and shear stress N/m) - SIMIP diags - definitions following Coon (1974) and Feltham (2008)
          IF( iom_use('normstr') )   CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00(:,:) ) ! Normal stress
          IF( iom_use('sheastr') )   CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00(:,:) ) ! Maximum shear stress
-         
+
          DEALLOCATE ( zsig_I, zsig_II )
-         
+
       ENDIF
 
@@ -818 +818 @@
       IF( iom_use('sig1_pnorm') .OR. iom_use('sig2_pnorm') ) THEN
          !
-         ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )         
-         !         
+         ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )
+         !
          DO_2D( 1, 1, 1, 1 )
-            
-            ! Ice stresses computed with **viscosities** (delta, p/delta) at **previous** iterates 
+
+            ! Ice stresses computed with **viscosities** (delta, p/delta) at **previous** iterates
             !                        and **deformations** at current iterates
             !                        following Lemieux & Dupont (2020)
@@ -829 +829 @@
             zsig2            =   zfac * z1_ecc2 * zten_i(ji,jj)
             zsig12           =   zfac * z1_ecc2 * pshear_i(ji,jj)
-            
+
             ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008), T-point
             zsig_I(ji,jj)    =   zsig1 * 0.5_wp                                            ! 1st stress invariant, aka average normal stress, aka negative pressure
             zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )   ! 2nd  ''       '', aka maximum shear stress
-            
+
             ! Normalized  principal stresses (used to display the ellipse)
             z1_strength      =   1._wp / MAX( 1._wp, strength(ji,jj) )
             zsig1_p(ji,jj)   =   ( zsig_I(ji,jj) + zsig_II(ji,jj) ) * z1_strength
             zsig2_p(ji,jj)   =   ( zsig_I(ji,jj) - zsig_II(ji,jj) ) * z1_strength
-         END_2D              
-         !
-         CALL iom_put( 'sig1_pnorm' , zsig1_p ) 
-         CALL iom_put( 'sig2_pnorm' , zsig2_p ) 
+         END_2D
+         !
+         CALL iom_put( 'sig1_pnorm' , zsig1_p )
+         CALL iom_put( 'sig2_pnorm' , zsig2_p )
 
          DEALLOCATE( zsig1_p , zsig2_p , zsig_I, zsig_II )
-         
+
       ENDIF
 
@@ -889 +889 @@
 
          CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice )   ! X-component of sea-ice mass transport (kg/s)
-         CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice )   ! Y-component of sea-ice mass transport 
+         CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice )   ! Y-component of sea-ice mass transport
          CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw )   ! X-component of snow mass transport (kg/s)
          CALL iom_put( 'ymtrpsnw' , zdiag_ymtrp_snw )   ! Y-component of snow mass transport
@@ -911 +911 @@
             ENDIF
          ENDIF
-      ENDIF      
+      ENDIF
       !
       DEALLOCATE( zmsk00, zmsk15 )
@@ -921 +921 @@
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE rhg_cvg  ***
-      !!                     
+      !!
       !! ** Purpose :   check convergence of oce rheology
       !!
@@ -929 +929 @@
       !!                This routine is called every sub-iteration, so it is cpu expensive
       !!
-      !! ** Note    :   for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)   
+      !! ** Note    :   for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)
       !!----------------------------------------------------------------------
       INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index
@@ -936 +936 @@
       INTEGER           ::   it, idtime, istatus
       INTEGER           ::   ji, jj          ! dummy loop indices
-      REAL(wp)          ::   zresm           ! local real 
+      REAL(wp)          ::   zresm           ! local real
       CHARACTER(len=20) ::   clname
       REAL(wp), DIMENSION(jpi,jpj) ::   zres           ! check convergence
@@ -963 +963 @@
       ! time
       it = ( kt - 1 ) * kitermax + kiter
-      
+
       ! convergence
       IF( kiter == 1 ) THEN ! remove the first iteration for calculations of convergence (always very large)
@@ -982 +982 @@
          IF( kt == nitend - nn_fsbc + 1 )   istatus = NF90_CLOSE(ncvgid)
       ENDIF
-      
+
    END SUBROUTINE rhg_cvg
 
@@ -989 +989 @@
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE rhg_evp_rst  ***
-      !!                     
+      !!
       !! ** Purpose :   Read or write RHG file in restart file
       !!
@@ -1041 +1041 @@
    END SUBROUTINE rhg_evp_rst
 
-   
+
 #else
    !!----------------------------------------------------------------------

NEMO/trunk/src/ICE/iceistate.F90

@@ -18 +18 @@
    USE oce            ! dynamics and tracers variables
    USE dom_oce        ! ocean domain
-   USE sbc_oce , ONLY : sst_m, sss_m, ln_ice_embd 
+   USE sbc_oce , ONLY : sst_m, sss_m, ln_ice_embd
    USE sbc_ice , ONLY : tn_ice, snwice_mass, snwice_mass_b
    USE eosbn2         ! equation of state
@@ -40 +40 @@
    USE agrif_oce
    USE agrif_ice
-   USE agrif_ice_interp 
-# endif   
+   USE agrif_ice_interp
+# endif
 
    IMPLICIT NONE
@@ -91 +91 @@
       !!
       !! ** Method  :   This routine will put some ice where ocean
-      !!                is at the freezing point, then fill in ice 
-      !!                state variables using prescribed initial 
-      !!                values in the namelist            
+      !!                is at the freezing point, then fill in ice
+      !!                state variables using prescribed initial
+      !!                values in the namelist
       !!
       !! ** Steps   :   1) Set initial surface and basal temperatures
@@ -103 +103 @@
       !!              where there is no ice
       !!--------------------------------------------------------------------
-      INTEGER, INTENT(in) :: kt            ! time step 
+      INTEGER, INTENT(in) :: kt            ! time step
       INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
       !
@@ -129 +129 @@
       ! basal temperature (considered at freezing point)   [Kelvin]
       CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
-      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
+      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)
       !
       ! surface temperature and conductivity
@@ -154 +154 @@
       e_i (:,:,:,:) = 0._wp
       e_s (:,:,:,:) = 0._wp
-      
+
       ! general fields
       a_i (:,:,:) = 0._wp
@@ -229 +229 @@
                IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) &
                   &     si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc.
-                  &                              * si(jp_ati)%fnow(:,:,1) 
+                  &                              * si(jp_ati)%fnow(:,:,1)
                !
                ! pond depth
@@ -248 +248 @@
                !
                ! change the switch for the following
-               WHERE( zat_i_ini(:,:) > 0._wp )   ;   zswitch(:,:) = tmask(:,:,1) 
+               WHERE( zat_i_ini(:,:) > 0._wp )   ;   zswitch(:,:) = tmask(:,:,1)
                ELSEWHERE                         ;   zswitch(:,:) = 0._wp
                END WHERE
@@ -256 +256 @@
                !                          !---------------!
                ! no ice if (sst - Tfreez) >= thresold
-               WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst )   ;   zswitch(:,:) = 0._wp 
+               WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst )   ;   zswitch(:,:) = 0._wp
                ELSEWHERE                                                                    ;   zswitch(:,:) = tmask(:,:,1)
                END WHERE
@@ -269 +269 @@
                   zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:)
                   ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:)
-                  zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
+                  zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.
                   zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:)
                   zhlid_ini(:,:) = rn_hld_ini_n * zswitch(:,:)
@@ -295 +295 @@
                zhlid_ini(:,:) = 0._wp
             ENDIF
-            
+
             IF ( .NOT.ln_pnd_lids ) THEN
                zhlid_ini(:,:) = 0._wp
             ENDIF
-            
+
             !----------------!
             ! 3) fill fields !
@@ -323 +323 @@
             CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini )
             CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d(1:npti)  , zhlid_ini )
-            
+
             ! allocate temporary arrays
             ALLOCATE( zhi_2d (npti,jpl), zhs_2d (npti,jpl), zai_2d (npti,jpl), &
@@ -377 +377 @@
             DO jl = 1, jpl
                DO_3D( 1, 1, 1, 1, 1, nlay_i )
-                  t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 
+                  t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)
                   ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K
                   e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * &
@@ -385 +385 @@
                END_3D
             END DO
-            
+
 #if  defined key_agrif
          ELSE
- 
+
             Agrif_SpecialValue    = -9999.
             Agrif_UseSpecialValue = .TRUE.
@@ -399 +399 @@
             use_sign_north = .FALSE.
             Agrif_UseSpecialValue = .FALSE.
-        ! lbc ???? 
+        ! lbc ????
    ! Here we know : a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, v_il, t_su, e_s, e_i
             CALL ice_var_glo2eqv
@@ -413 +413 @@
          v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:)
          v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:)
-         
+
          ! specific temperatures for coupled runs
          tn_ice(:,:,:) = t_su(:,:,:)
@@ -456 +456 @@
       !!-------------------------------------------------------------------
       !!                   ***  ROUTINE ice_istate_init  ***
-      !!        
-      !! ** Purpose :   Definition of initial state of the ice 
-      !!
-      !! ** Method  :   Read the namini namelist and check the parameter 
+      !!
+      !! ** Purpose :   Definition of initial state of the ice
+      !!
+      !! ** Method  :   Read the namini namelist and check the parameter
       !!              values called at the first timestep (nit000)
       !!
@@ -500 +500 @@
          WRITE(numout,*) '      max ocean temp. above Tfreeze with initial ice   rn_thres_sst   = ', rn_thres_sst
          IF( ln_iceini .AND. nn_iceini_file == 0 ) THEN
-            WRITE(numout,*) '      initial snw thickness in the north-south         rn_hts_ini     = ', rn_hts_ini_n,rn_hts_ini_s 
+            WRITE(numout,*) '      initial snw thickness in the north-south         rn_hts_ini     = ', rn_hts_ini_n,rn_hts_ini_s
             WRITE(numout,*) '      initial ice thickness in the north-south         rn_hti_ini     = ', rn_hti_ini_n,rn_hti_ini_s
             WRITE(numout,*) '      initial ice concentr  in the north-south         rn_ati_ini     = ', rn_ati_ini_n,rn_ati_ini_s

NEMO/trunk/src/ICE/iceitd.F90

@@ -18 +18 @@
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean domain
-   USE phycst         ! physical constants 
+   USE phycst         ! physical constants
    USE ice1D          ! sea-ice: thermodynamic variables
    USE ice            ! sea-ice: variables
@@ -66 +66 @@
       !!                after thermodynamic growth of ice thickness
       !!
-      !! ** Method  :   Linear remapping 
+      !! ** Method  :   Linear remapping
       !!
       !! References :   W.H. Lipscomb, JGR 2001
       !!------------------------------------------------------------------
-      INTEGER , INTENT (in) ::   kt      ! Ocean time step 
+      INTEGER , INTENT (in) ::   kt      ! Ocean time step
       !
       INTEGER  ::   ji, jj, jl, jcat     ! dummy loop index
@@ -76 +76 @@
       REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars
       REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      -
-      REAL(wp) ::   zx3        
+      REAL(wp) ::   zx3
       REAL(wp) ::   zslope          ! used to compute local thermodynamic "speeds"
       !
@@ -90 +90 @@
       IF( ln_timing )   CALL timing_start('iceitd_rem')
 
-      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_rem: remapping ice thickness distribution' 
+      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_rem: remapping ice thickness distribution'
 
       IF( ln_icediachk )   CALL ice_cons_hsm(0, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
@@ -107 +107 @@
          ENDIF
       END_2D
-      
+
       !-----------------------------------------------------------------------------------------------
       !  2) Compute new category boundaries
@@ -143 +143 @@
                ELSEIF( a_ib_2d(ji,jl) <= epsi10 .AND. a_ib_2d(ji,jl+1) >  epsi10 ) THEN   ! a(jl)=0 => Hn* = Hn + fn+1*dt
                   zhbnew(ji,jl) = hi_max(jl) + zdhice(ji,jl+1)
-               ELSE                                                                       ! a(jl+1) & a(jl) = 0 
+               ELSE                                                                       ! a(jl+1) & a(jl) = 0
                   zhbnew(ji,jl) = hi_max(jl)
                ENDIF
                !
                ! --- 2 conditions for remapping --- !
-               ! 1) hn(t+1)+espi < Hn* < hn+1(t+1)-epsi               
-               !    Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 
+               ! 1) hn(t+1)+espi < Hn* < hn+1(t+1)-epsi
+               !    Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible
                !          in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
 # if defined key_single
@@ -159 +159 @@
 # endif
                !
-               ! 2) Hn-1 < Hn* < Hn+1  
+               ! 2) Hn-1 < Hn* < Hn+1
                IF( zhbnew(ji,jl) < hi_max(jl-1) )   nptidx(ji) = 0
                IF( zhbnew(ji,jl) > hi_max(jl+1) )   nptidx(ji) = 0
@@ -171 +171 @@
                zhbnew(ji,jpl) = MAX( hi_max(jpl-1), 3._wp * h_i_2d(ji,jpl) - 2._wp * zhbnew(ji,jpl-1) )
             ELSE
-               zhbnew(ji,jpl) = hi_max(jpl)  
+               zhbnew(ji,jpl) = hi_max(jpl)
             ENDIF
             !
             ! --- 1 additional condition for remapping (1st category) --- !
-            ! H0+epsi < h1(t) < H1-epsi 
-            !    h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 
+            ! H0+epsi < h1(t) < H1-epsi
+            !    h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible
             !    in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice)
 # if defined key_single
@@ -202 +202 @@
          !
       ENDIF
-   
+
       !-----------------------------------------------------------------------------------------------
-      !  4) Compute g(h) 
+      !  4) Compute g(h)
       !-----------------------------------------------------------------------------------------------
       IF( npti > 0 ) THEN
          !
          zhb0(:) = hi_max(0)   ;   zhb1(:) = hi_max(1)
-         g0(:,:) = 0._wp       ;   g1(:,:) = 0._wp 
-         hL(:,:) = 0._wp       ;   hR(:,:) = 0._wp 
+         g0(:,:) = 0._wp       ;   g1(:,:) = 0._wp
+         hL(:,:) = 0._wp       ;   hR(:,:) = 0._wp
          !
          DO jl = 1, jpl
@@ -220 +220 @@
             !
             IF( jl == 1 ) THEN
-               !  
+               !
                ! --- g(h) for category 1 --- !
                CALL itd_glinear( zhb0(1:npti)  , zhb1(1:npti)  , h_ib_1d(1:npti)  , a_i_1d(1:npti)  ,  &   ! in
@@ -230 +230 @@
                   IF( a_i_1d(ji) > epsi10 ) THEN
                      !
-                     zdh0 =  h_i_1d(ji) - h_ib_1d(ji)                
+                     zdh0 =  h_i_1d(ji) - h_ib_1d(ji)
                      IF( zdh0 < 0.0 ) THEN      ! remove area from category 1
                         zdh0 = MIN( -zdh0, hi_max(1) )
@@ -238 +238 @@
                         IF( zetamax > 0.0 ) THEN
                            zx1    = zetamax
-                           zx2    = 0.5 * zetamax * zetamax 
+                           zx2    = 0.5 * zetamax * zetamax
                            zda0   = g1(ji,1) * zx2 + g0(ji,1) * zx1                ! ice area removed
-                           zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i                
+                           zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i
                            zda0   = MIN( zda0, zdamax )                            ! ice area lost due to melting of thin ice (zdamax > 0)
                            ! Remove area, conserving volume
@@ -250 +250 @@
                      ELSE ! if ice accretion zdh0 > 0
                         ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1)
-                        zhbnew(ji,0) = MIN( zdh0, hi_max(1) ) 
+                        zhbnew(ji,0) = MIN( zdh0, hi_max(1) )
                      ENDIF
                      !
@@ -263 +263 @@
             ENDIF ! jl=1
             !
-            ! --- g(h) for each thickness category --- !  
+            ! --- g(h) for each thickness category --- !
             CALL itd_glinear( zhbnew(1:npti,jl-1), zhbnew(1:npti,jl), h_i_1d(1:npti)   , a_i_1d(1:npti)   ,  &   ! in
                &              g0    (1:npti,jl  ), g1    (1:npti,jl), hL    (1:npti,jl), hR    (1:npti,jl)   )   ! out
             !
          END DO
-         
+
          !-----------------------------------------------------------------------------------------------
          !  5) Compute area and volume to be shifted across each boundary (Eq. 18)
@@ -278 +278 @@
                ! left and right integration limits in eta space
                IF (zhbnew(ji,jl) > hi_max(jl)) THEN ! Hn* > Hn => transfer from jl to jl+1
-                  zetamin = MAX( hi_max(jl)   , hL(ji,jl) ) - hL(ji,jl)   ! hi_max(jl) - hL 
+                  zetamin = MAX( hi_max(jl)   , hL(ji,jl) ) - hL(ji,jl)   ! hi_max(jl) - hL
                   zetamax = MIN( zhbnew(ji,jl), hR(ji,jl) ) - hL(ji,jl)   ! hR - hL
                   jdonor(ji,jl) = jl
@@ -301 +301 @@
             END DO
          END DO
-         
+
          !----------------------------------------------------------------------------------------------
          ! 6) Shift ice between categories
          !----------------------------------------------------------------------------------------------
          CALL itd_shiftice ( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) )
-         
+
          !----------------------------------------------------------------------------------------------
          ! 7) Make sure h_i >= minimum ice thickness hi_min
@@ -316 +316 @@
          DO ji = 1, npti
             IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN
-               a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin 
+               a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin
                IF( ln_pnd_LEV .OR. ln_pnd_TOPO )   a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin
                h_i_1d(ji) = rn_himin
@@ -384 +384 @@
             pg1(ji) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5_wp )   ! Eq. 14
             !
-         ELSE  ! remap_flag = .false. or a_i < epsi10 
+         ELSE  ! remap_flag = .false. or a_i < epsi10
             phL(ji) = 0._wp
             phR(ji) = 0._wp
@@ -415 +415 @@
       REAL(wp), DIMENSION(jpij,nlay_s,jpl) ::   ze_s_2d
       !!------------------------------------------------------------------
-         
+
       CALL tab_3d_2d( npti, nptidx(1:npti), h_i_2d (1:npti,1:jpl), h_i  )
       CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i  )
@@ -445 +445 @@
          END DO
       END DO
-      
+
       !-------------------------------------------------------------------------------
       ! 2) Transfer volume and energy between categories
@@ -457 +457 @@
                !
                IF ( jl1 == jl  ) THEN   ;   jl2 = jl1+1
-               ELSE                     ;   jl2 = jl 
+               ELSE                     ;   jl2 = jl
                ENDIF
                !
@@ -475 +475 @@
                ztrans         = v_s_2d(ji,jl1) * zworkv(ji)          ! Snow volumes
                v_s_2d(ji,jl1) = v_s_2d(ji,jl1) - ztrans
-               v_s_2d(ji,jl2) = v_s_2d(ji,jl2) + ztrans 
+               v_s_2d(ji,jl2) = v_s_2d(ji,jl2) + ztrans
                !
                ztrans          = oa_i_2d(ji,jl1) * zworka(ji)        ! Ice age
@@ -488 +488 @@
                zaTsfn(ji,jl1)  = zaTsfn(ji,jl1) - ztrans
                zaTsfn(ji,jl2)  = zaTsfn(ji,jl2) + ztrans
-               !  
+               !
                IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN
                   ztrans          = a_ip_2d(ji,jl1) * zworka(ji)     ! Pond fraction
                   a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - ztrans
                   a_ip_2d(ji,jl2) = a_ip_2d(ji,jl2) + ztrans
-                  !                                              
+                  !
                   ztrans          = v_ip_2d(ji,jl1) * zworkv(ji)     ! Pond volume
                   v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans
@@ -555 +555 @@
             &   a_i_2d(1:npti,jl) = a_i_2d(1:npti,jl) * rn_amax_1d(1:npti) / zworka(1:npti)
       END DO
-      
+
       !-------------------------------------------------------------------------------
       ! 4) Update ice thickness and temperature
@@ -564 +564 @@
       WHERE( a_i_2d(1:npti,:) >= epsi20 )
 # endif
-         h_i_2d (1:npti,:)  =  v_i_2d(1:npti,:) / a_i_2d(1:npti,:) 
-         t_su_2d(1:npti,:)  =  zaTsfn(1:npti,:) / a_i_2d(1:npti,:) 
+         h_i_2d (1:npti,:)  =  v_i_2d(1:npti,:) / a_i_2d(1:npti,:)
+         t_su_2d(1:npti,:)  =  zaTsfn(1:npti,:) / a_i_2d(1:npti,:)
       ELSEWHERE
          h_i_2d (1:npti,:)  = 0._wp
@@ -591 +591 @@
       !
    END SUBROUTINE itd_shiftice
-   
+
 
    SUBROUTINE ice_itd_reb( kt )
@@ -603 +603 @@
       !!              to the neighboring category
       !!------------------------------------------------------------------
-      INTEGER , INTENT (in) ::   kt      ! Ocean time step 
+      INTEGER , INTENT (in) ::   kt      ! Ocean time step
       INTEGER ::   ji, jj, jl   ! dummy loop indices
       !
@@ -611 +611 @@
       IF( ln_timing )   CALL timing_start('iceitd_reb')
       !
-      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution' 
+      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution'
       !
       IF( ln_icediachk )   CALL ice_cons_hsm(0, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
@@ -627 +627 @@
             IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN
                npti = npti + 1
-               nptidx( npti ) = (jj - 1) * jpi + ji                  
+               nptidx( npti ) = (jj - 1) * jpi + ji
             ENDIF
          END_2D
          !
-         IF( npti > 0 ) THEN            
+         IF( npti > 0 ) THEN
             !!clem   CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) )
             CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl) )
@@ -637 +637 @@
             !
             DO ji = 1, npti
-               jdonor(ji,jl)  = jl 
+               jdonor(ji,jl)  = jl
                ! how much of a_i you send in cat sup is somewhat arbitrary
                ! these are from CICE => transfer everything
@@ -663 +663 @@
             IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN
                npti = npti + 1
-               nptidx( npti ) = (jj - 1) * jpi + ji                  
+               nptidx( npti ) = (jj - 1) * jpi + ji
             ENDIF
          END_2D
@@ -672 +672 @@
             DO ji = 1, npti
                jdonor(ji,jl) = jl + 1
-               zdaice(ji,jl) = a_i_1d(ji) 
+               zdaice(ji,jl) = a_i_1d(ji)
                zdvice(ji,jl) = v_i_1d(ji)
             END DO
@@ -721 +721 @@
          WRITE(numout,*) '         mean ice thickness in the domain                               rn_himean  = ', rn_himean
          WRITE(numout,*) '      Ice categories are defined by rn_catbnd                           ln_cat_usr = ', ln_cat_usr
-         WRITE(numout,*) '      minimum ice thickness allowed                                     rn_himin   = ', rn_himin 
-         WRITE(numout,*) '      maximum ice thickness allowed                                     rn_himax   = ', rn_himax 
+         WRITE(numout,*) '      minimum ice thickness allowed                                     rn_himin   = ', rn_himin
+         WRITE(numout,*) '      maximum ice thickness allowed                                     rn_himax   = ', rn_himax
       ENDIF
       !
@@ -729 +729 @@
       !-----------------------------------!
       !                             !== set the choice of ice categories ==!
-      ioptio = 0 
+      ioptio = 0
       IF( ln_cat_hfn ) THEN   ;   ioptio = ioptio + 1   ;   nice_catbnd = np_cathfn    ;   ENDIF
       IF( ln_cat_usr ) THEN   ;   ioptio = ioptio + 1   ;   nice_catbnd = np_catusr    ;   ENDIF

NEMO/trunk/src/ICE/icerst.F90

@@ -11 +11 @@
    !!----------------------------------------------------------------------
    !!   ice_rst_opn   : open  restart file
-   !!   ice_rst_write : write restart file 
-   !!   ice_rst_read  : read  restart file 
+   !!   ice_rst_write : write restart file
+   !!   ice_rst_read  : read  restart file
    !!----------------------------------------------------------------------
    USE ice            ! sea-ice: variables
@@ -54 +54 @@
       CHARACTER(len=20)   ::   clkt     ! ocean time-step define as a character
       CHARACTER(len=50)   ::   clname   ! ice output restart file name
-      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file 
+      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file
       CHARACTER(LEN=52)   ::   clpname   ! ocean output restart file name including prefix for AGRIF
       !!----------------------------------------------------------------------
@@ -61 +61 @@
 
       IF( ln_rst_list .OR. nn_stock /= -1 ) THEN
-      ! in order to get better performances with NetCDF format, we open and define the ice restart file 
-      ! one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), except if we write ice 
+      ! in order to get better performances with NetCDF format, we open and define the ice restart file
+      ! one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), except if we write ice
       ! restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1
       IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nn_stock == nn_fsbc    &
@@ -73 +73 @@
             ! create the file
             clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
-            clpath = TRIM(cn_icerst_outdir) 
+            clpath = TRIM(cn_icerst_outdir)
             IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
             IF(lwp) THEN
@@ -132 +132 @@
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'ice_rst_write : write ice restart file  kt =', kt
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'         
-      ENDIF
-      
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
+      ENDIF
+
       ! Write in numriw (if iter == nitrst)
-      ! ------------------ 
+      ! ------------------
       !                                                                        ! calendar control
-      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step 
+      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step
       CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter   , wp ) )      ! date
-      
+
       IF(.NOT.lwxios) CALL iom_delay_rst( 'WRITE', 'ICE', numriw )   ! save only ice delayed global communication variables
 
@@ -156 +156 @@
       CALL iom_rstput( iter, nitrst, numriw, 'v_il' , v_il  )
       ! Snow enthalpy
-      DO jk = 1, nlay_s 
+      DO jk = 1, nlay_s
          WRITE(zchar1,'(I2.2)') jk
          znam = 'e_s'//'_l'//zchar1
@@ -163 +163 @@
       END DO
       ! Ice enthalpy
-      DO jk = 1, nlay_i 
+      DO jk = 1, nlay_i
          WRITE(zchar1,'(I2.2)') jk
          znam = 'e_i'//'_l'//zchar1
@@ -224 +224 @@
 !            clpname = cn_icerst_in
 !         ELSE
-!            clpname = TRIM(Agrif_CFixed())//"_"//cn_icerst_in   
+!            clpname = TRIM(Agrif_CFixed())//"_"//cn_icerst_in
 !         ENDIF
           CALL iom_init( cr_icerst_cxt, kdid = numrir, ld_closedef = .TRUE. )
       ENDIF
 
-      ! test if v_i exists 
+      ! test if v_i exists
       id0 = iom_varid( numrir, 'v_i' , ldstop = .FALSE. )
 
@@ -237 +237 @@
          ! Time info
          CALL iom_get( numrir, 'nn_fsbc', zfice )
-         CALL iom_get( numrir, 'kt_ice' , ziter )    
+         CALL iom_get( numrir, 'kt_ice' , ziter )
          IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter
          IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1
@@ -251 +251 @@
             &                   '   control of time parameter  nrstdt' )
 
-         ! --- mandatory fields --- ! 
+         ! --- mandatory fields --- !
          CALL iom_get( numrir, jpdom_auto, 'v_i'  , v_i   )
          CALL iom_get( numrir, jpdom_auto, 'v_s'  , v_s   )

NEMO/trunk/src/ICE/icesbc.F90

@@ -59 +59 @@
       !!
       INTEGER  ::   ji, jj                 ! dummy loop index
-      REAL(wp), DIMENSION(jpi,jpj) ::   zutau_ice, zvtau_ice 
+      REAL(wp), DIMENSION(jpi,jpj) ::   zutau_ice, zvtau_ice
       !!-------------------------------------------------------------------
       !
@@ -72 +72 @@
       SELECT CASE( ksbc )
          CASE( jp_usr     )   ;    CALL usrdef_sbc_ice_tau( kt )                 ! user defined formulation
-         CASE( jp_blk     )   ;    CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   &
-            &                                      sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   &
+      CASE( jp_blk     )
+         CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   &
+            &                                      theta_air_zt(:,:), q_air_zt(:,:),   &   ! #LB: known from "sbc_oce" module...
             &                                      sf(jp_slp )%fnow(:,:,1), u_ice, v_ice, tm_su    ,   &   ! inputs
-            &                                      putaui = utau_ice, pvtaui = vtau_ice            )       ! outputs                             
+            &                                      putaui = utau_ice, pvtaui = vtau_ice            )       ! outputs
  !        CASE( jp_abl     )    utau_ice & vtau_ice are computed in ablmod
          CASE( jp_purecpl )   ;    CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )   ! Coupled      formulation
@@ -93 +94 @@
    END SUBROUTINE ice_sbc_tau
 
-   
+
    SUBROUTINE ice_sbc_flx( kt, ksbc )
       !!-------------------------------------------------------------------
@@ -108 +109 @@
       !!                dqns_ice                                 = non solar  heat sensistivity                  [W/m2]
       !!                qemp_oce, qemp_ice, qprec_ice, qevap_ice = sensible heat (associated with evap & precip) [W/m2]
-      !!            + some fields that are not used outside this module: 
+      !!            + some fields that are not used outside this module:
       !!                qla_ice                                  = latent heat flux over ice                     [W/m2]
       !!                dqla_ice                                 = latent heat sensistivity                      [W/m2]
@@ -118 +119 @@
       !
       INTEGER  ::   ji, jj, jl      ! dummy loop index
-      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios 
+      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios
       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace
       !!--------------------------------------------------------------------
@@ -142 +143 @@
                                   CALL usrdef_sbc_ice_flx( kt, h_s, h_i )
       CASE( jp_blk, jp_abl )  !--- bulk formulation & ABL formulation
-                                  CALL blk_ice_2    ( t_su, h_s, h_i, alb_ice, sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),    &
-            &                                           sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) )    ! 
+                                  CALL blk_ice_2    ( t_su, h_s, h_i, alb_ice, &
+            &                                         theta_air_zt(:,:), q_air_zt(:,:),    &   ! #LB: known from "sbc_oce" module...
+            &                                         sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), &
+            &                                         sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) )
          IF( ln_mixcpl        )   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
          IF( nn_flxdist /= -1 )   CALL ice_flx_dist   ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist )
@@ -163 +166 @@
             zalb  (:,:) = rn_alb_oce
          ELSEWHERE
-            zmsk00(:,:) = 1._wp            
+            zmsk00(:,:) = 1._wp
             zalb  (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b
          END WHERE
@@ -185 +188 @@
       !!                  ***  ROUTINE ice_flx_dist  ***
       !!
-      !! ** Purpose :   update the ice surface boundary condition by averaging 
+      !! ** Purpose :   update the ice surface boundary condition by averaging
       !!              and/or redistributing fluxes on ice categories
       !!
@@ -192 +195 @@
       !! ** Action  :   depends on k_flxdist
       !!                = -1  Do nothing (needs N(cat) fluxes)
-      !!                =  0  Average N(cat) fluxes then apply the average over the N(cat) ice 
+      !!                =  0  Average N(cat) fluxes then apply the average over the N(cat) ice
       !!                =  1  Average N(cat) fluxes then redistribute over the N(cat) ice
       !!                                                 using T-ice and albedo sensitivity
@@ -222 +225 @@
       ELSEWHERE                      ; z1_at_i(:,:) = 0._wp
       END WHERE
-      
+
       SELECT CASE( k_flxdist )       !==  averaged on all ice categories  ==!
       !
       CASE( 0 , 1 )
          !
-         ALLOCATE( z_qns_m(jpi,jpj), z_qsr_m(jpi,jpj), z_dqn_m(jpi,jpj), z_evap_m(jpi,jpj), z_devap_m(jpi,jpj) )  
+         ALLOCATE( z_qns_m(jpi,jpj), z_qsr_m(jpi,jpj), z_dqn_m(jpi,jpj), z_evap_m(jpi,jpj), z_devap_m(jpi,jpj) )
          !
          z_qns_m  (:,:) = SUM( a_i(:,:,:) * pqns_ice  (:,:,:) , dim=3 ) * z1_at_i(:,:)
@@ -242 +245 @@
          END DO
          !
-         DEALLOCATE( z_qns_m, z_qsr_m, z_dqn_m, z_evap_m, z_devap_m )  
+         DEALLOCATE( z_qns_m, z_qsr_m, z_dqn_m, z_evap_m, z_devap_m )
          !
       END SELECT
@@ -250 +253 @@
       CASE( 1 , 2 )
          !
-         ALLOCATE( zalb_m(jpi,jpj), ztem_m(jpi,jpj) )  
+         ALLOCATE( zalb_m(jpi,jpj), ztem_m(jpi,jpj) )
          !
          zalb_m(:,:) = SUM( a_i(:,:,:) * palb_ice(:,:,:) , dim=3 ) * z1_at_i(:,:)
@@ -260 +263 @@
          END DO
          !
-         DEALLOCATE( zalb_m, ztem_m )  
+         DEALLOCATE( zalb_m, ztem_m )
          !
       END SELECT
@@ -272 +275 @@
       !!
       !! ** Purpose :   Physical constants and parameters linked to the ice dynamics
-      !!      
+      !!
       !! ** Method  :   Read the namsbc namelist and check the ice-dynamic
       !!              parameter values called at the first timestep (nit000)

NEMO/trunk/src/ICE/icestp.F90

@@ -8 +8 @@
    !!                        aka Sea Ice cube for its nickname
    !!
-   !!    is originally based on LIM3, developed in Louvain-la-Neuve by: 
+   !!    is originally based on LIM3, developed in Louvain-la-Neuve by:
    !!       * Martin Vancoppenolle (UCL-ASTR, Belgium)
    !!       * Sylvain Bouillon (UCL-ASTR, Belgium)
@@ -140 +140 @@
          IF( .NOT. Agrif_Root() )       nbstep_ice = MOD( nbstep_ice, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) + 1
          !                              ! these calls must remain here for restartability purposes
-                                        CALL agrif_interp_ice( 'T' ) 
+                                        CALL agrif_interp_ice( 'T' )
                                         CALL agrif_interp_ice( 'U' )
                                         CALL agrif_interp_ice( 'V' )
@@ -152 +152 @@
          !    utau_ice, vtau_ice = surface ice stress [N/m2]
          !------------------------------------------------!
-                                        CALL ice_sbc_tau( kt, ksbc, utau_ice, vtau_ice )          
+                                        CALL ice_sbc_tau( kt, ksbc, utau_ice, vtau_ice )
          !-------------------------------------!
          ! --- ice dynamics and advection  --- !
          !-------------------------------------!
                                         CALL diag_set0                ! set diag of mass, heat and salt fluxes to 0
-                                        CALL ice_rst_opn( kt )        ! Open Ice restart file (if necessary) 
+                                        CALL ice_rst_opn( kt )        ! Open Ice restart file (if necessary)
          !
          IF( ln_icedyn .AND. .NOT.lk_c1d )   &
@@ -169 +169 @@
          !                          !==  previous lead fraction and ice volume for flux calculations
                                         CALL ice_var_glo2eqv          ! h_i and h_s for ice albedo calculation
-                                        CALL ice_var_agg(1)           ! at_i for coupling 
+                                        CALL ice_var_agg(1)           ! at_i for coupling
                                         CALL store_fields             ! Store now ice values
          !
@@ -189 +189 @@
          ! --- ice thermodynamics --- !
          !----------------------------!
-         IF( ln_icethd )                CALL ice_thd( kt )            ! -- Ice thermodynamics      
+         IF( ln_icethd )                CALL ice_thd( kt )            ! -- Ice thermodynamics
          !
                                         CALL diag_trends( 2 )         ! record thermo trends
@@ -197 +197 @@
                                         CALL ice_update_flx( kt )     ! -- Update ocean surface mass, heat and salt fluxes
          !
-         IF( ln_icediahsb )             CALL ice_dia( kt )            ! -- Diagnostics outputs 
-         !
-         IF( ln_icediachk )             CALL ice_drift_wri( kt )      ! -- Diagnostics outputs for conservation 
-         !
-                                        CALL ice_wri( kt )            ! -- Ice outputs 
-         !
-         IF( lrst_ice )                 CALL ice_rst_write( kt )      ! -- Ice restart file 
+         IF( ln_icediahsb )             CALL ice_dia( kt )            ! -- Diagnostics outputs
+         !
+         IF( ln_icediachk )             CALL ice_drift_wri( kt )      ! -- Diagnostics outputs for conservation
+         !
+                                        CALL ice_wri( kt )            ! -- Ice outputs
+         !
+         IF( lrst_ice )                 CALL ice_rst_write( kt )      ! -- Ice restart file
          !
          IF( ln_icectl )                CALL ice_ctl( kt )            ! -- Control checks
@@ -231 +231 @@
       !!----------------------------------------------------------------------
       IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'Sea Ice Model: SI3 (Sea Ice modelling Integrated Initiative)' 
+      IF(lwp) WRITE(numout,*) 'Sea Ice Model: SI3 (Sea Ice modelling Integrated Initiative)'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
       IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'ice_init: Arrays allocation & Initialization of all routines & init state' 
+      IF(lwp) WRITE(numout,*) 'ice_init: Arrays allocation & Initialization of all routines & init state'
       IF(lwp) WRITE(numout,*) '~~~~~~~~'
       !
@@ -250 +250 @@
       !                                ! Allocate the ice arrays (sbc_ice already allocated in sbc_init)
       ierr =        ice_alloc        ()      ! ice variables
-      ierr = ierr + sbc_ice_alloc    ()      ! surface boundary conditions 
+      ierr = ierr + sbc_ice_alloc    ()      ! surface boundary conditions
       ierr = ierr + ice1D_alloc      ()      ! thermodynamics
       !
@@ -333 +333 @@
          WRITE(numout,*) '         Ice dynamics       (T) or not (F)                   ln_icedyn = ', ln_icedyn
          WRITE(numout,*) '         Ice thermodynamics (T) or not (F)                   ln_icethd = ', ln_icethd
-         WRITE(numout,*) '         maximum ice concentration for NH                              = ', rn_amax_n 
+         WRITE(numout,*) '         maximum ice concentration for NH                              = ', rn_amax_n
          WRITE(numout,*) '         maximum ice concentration for SH                              = ', rn_amax_s
       ENDIF
@@ -417 +417 @@
          wfx_bom(ji,jj) = 0._wp   ;   wfx_sum(ji,jj) = 0._wp
          wfx_res(ji,jj) = 0._wp   ;   wfx_sub(ji,jj) = 0._wp
-         wfx_spr(ji,jj) = 0._wp   ;   wfx_lam(ji,jj) = 0._wp  
+         wfx_spr(ji,jj) = 0._wp   ;   wfx_lam(ji,jj) = 0._wp
          wfx_snw_dyn(ji,jj) = 0._wp ; wfx_snw_sum(ji,jj) = 0._wp
          wfx_snw_sub(ji,jj) = 0._wp ; wfx_ice_sub(ji,jj) = 0._wp
-         wfx_snw_sni(ji,jj) = 0._wp 
+         wfx_snw_sni(ji,jj) = 0._wp
          wfx_pnd(ji,jj) = 0._wp
 

NEMO/trunk/src/ICE/icetab.F90

@@ -17 +17 @@
    USE par_oce
    USE ice, ONLY : jpl
-   
+
    IMPLICIT NONE
    PRIVATE

NEMO/trunk/src/ICE/icethd.F90

@@ -69 +69 @@
    SUBROUTINE ice_thd( kt )
       !!-------------------------------------------------------------------
-      !!                ***  ROUTINE ice_thd  ***       
-      !!  
+      !!                ***  ROUTINE ice_thd  ***
+      !!
       !! ** Purpose : This routine manages ice thermodynamics
-      !!         
+      !!
       !! ** Action : - computation of oceanic sensible heat flux at the ice base
       !!                              energy budget in the leads
@@ -114 +114 @@
          ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp
       ENDIF
-      
+
       !---------------------------------------------!
       ! computation of friction velocity at T points
@@ -157 +157 @@
          ! --- Sensible ocean-to-ice heat flux (W/m2) --- !
          !     (mostly>0 but <0 if supercooling)
-         zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 
+         zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin )
          qsb_ice_bot(ji,jj) = rswitch * rho0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) )
-         
-         ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
+
+         ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach
          !                              the freezing point, so that we do not have SST < T_freeze
          !                              This implies: qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice <= - zqfr_neg
@@ -210 +210 @@
          !
       END_2D
-      
+
       ! In case we bypass open-water ice formation
       IF( .NOT. ln_icedO )  qlead(:,:) = 0._wp
@@ -227 +227 @@
          npti = 0 ; nptidx(:) = 0
          DO_2D( 1, 1, 1, 1 )
-            IF ( a_i(ji,jj,jl) > epsi10 ) THEN     
+            IF ( a_i(ji,jj,jl) > epsi10 ) THEN
                npti         = npti  + 1
                nptidx(npti) = (jj - 1) * jpi + ji
@@ -234 +234 @@
 
          IF( npti > 0 ) THEN  ! If there is no ice, do nothing.
-            !                                                                
+            !
                               CALL ice_thd_1d2d( jl, 1 )            ! --- Move to 1D arrays --- !
             !                                                       ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- !
             !
-            s_i_new   (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp   ! --- some init --- !  (important to have them here) 
-            dh_i_sum  (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm  (1:npti) = 0._wp 
+            s_i_new   (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp   ! --- some init --- !  (important to have them here)
+            dh_i_sum  (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm  (1:npti) = 0._wp
             dh_i_sub  (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp
             dh_snowice(1:npti) = 0._wp ; dh_s_mlt(1:npti) = 0._wp
-            !                                      
+            !
                               CALL ice_thd_zdf                      ! --- Ice-Snow temperature --- !
             !
             IF( ln_icedH ) THEN                                     ! --- Growing/Melting --- !
-                              CALL ice_thd_dh                           ! Ice-Snow thickness   
+                              CALL ice_thd_dh                           ! Ice-Snow thickness
                               CALL ice_thd_ent( e_i_1d(1:npti,:) )      ! Ice enthalpy remapping
             ENDIF
-                              CALL ice_thd_sal( ln_icedS )          ! --- Ice salinity --- !    
+                              CALL ice_thd_sal( ln_icedS )          ! --- Ice salinity --- !
             !
                               CALL ice_thd_temp                     ! --- Temperature update --- !
@@ -266 +266 @@
       IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
       IF( ln_icediachk )   CALL ice_cons2D  (1, 'icethd',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft)
-      !                   
+      !
       IF ( ln_pnd .AND. ln_icedH ) &
-         &                    CALL ice_thd_pnd                      ! --- Melt ponds 
+         &                    CALL ice_thd_pnd                      ! --- Melt ponds
       !
       IF( jpl > 1  )          CALL ice_itd_rem( kt )                ! --- Transport ice between thickness categories --- !
@@ -276 +276 @@
                               CALL ice_cor( kt , 2 )                ! --- Corrections --- !
       !
-      oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice              ! ice natural aging incrementation     
+      oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice              ! ice natural aging incrementation
       !
       ! convergence tests
@@ -290 +290 @@
       IF( ln_timing )   CALL timing_stop('icethd')                                        ! timing
       !
-   END SUBROUTINE ice_thd 
-
- 
+   END SUBROUTINE ice_thd
+
+
    SUBROUTINE ice_thd_temp
       !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE ice_thd_temp *** 
-      !!                 
+      !!                   ***  ROUTINE ice_thd_temp ***
+      !!
       !! ** Purpose :   Computes sea ice temperature (Kelvin) from enthalpy
       !!
@@ -302 +302 @@
       !!-------------------------------------------------------------------
       INTEGER  ::   ji, jk   ! dummy loop indices
-      REAL(wp) ::   ztmelts, zbbb, zccc  ! local scalar 
+      REAL(wp) ::   ztmelts, zbbb, zccc  ! local scalar
       !!-------------------------------------------------------------------
       ! Recover ice temperature
@@ -312 +312 @@
             zccc          = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts, 0._wp ) )
             t_i_1d(ji,jk) = rt0 - ( zbbb + zccc ) * 0.5_wp * r1_rcpi
-            
+
             ! mask temperature
-            rswitch       = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) ) 
+            rswitch       = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) )
             t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0
-         END DO 
-      END DO 
+         END DO
+      END DO
       !
    END SUBROUTINE ice_thd_temp
@@ -324 +324 @@
    SUBROUTINE ice_thd_mono
       !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE ice_thd_mono *** 
-      !!                 
+      !!                   ***  ROUTINE ice_thd_mono ***
+      !!
       !! ** Purpose :   Lateral melting in case virtual_itd
       !!                          ( dA = A/2h dh )
@@ -332 +332 @@
       REAL(wp) ::   zhi_bef            ! ice thickness before thermo
       REAL(wp) ::   zdh_mel, zda_mel   ! net melting
-      REAL(wp) ::   zvi, zvs           ! ice/snow volumes 
+      REAL(wp) ::   zvi, zvs           ! ice/snow volumes
       !!-----------------------------------------------------------------------
       !
@@ -344 +344 @@
             rswitch     = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) )
             zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) )
-            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel ) 
+            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel )
             ! adjust thickness
-            h_i_1d(ji) = zvi / a_i_1d(ji)            
-            h_s_1d(ji) = zvs / a_i_1d(ji)            
+            h_i_1d(ji) = zvi / a_i_1d(ji)
+            h_s_1d(ji) = zvs / a_i_1d(ji)
             ! retrieve total concentration
             at_i_1d(ji) = a_i_1d(ji)
@@ -358 +358 @@
    SUBROUTINE ice_thd_1d2d( kl, kn )
       !!-----------------------------------------------------------------------
-      !!                   ***  ROUTINE ice_thd_1d2d *** 
-      !!                 
+      !!                   ***  ROUTINE ice_thd_1d2d ***
+      !!
       !! ** Purpose :   move arrays from 1d to 2d and the reverse
       !!-----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kl   ! index of the ice category 
+      INTEGER, INTENT(in) ::   kl   ! index of the ice category
       INTEGER, INTENT(in) ::   kn   ! 1= from 2D to 1D   ;   2= from 1D to 2D
       !
@@ -394 +394 @@
          CALL tab_2d_1d( npti, nptidx(1:npti), dqns_ice_1d   (1:npti), dqns_ice(:,:,kl)     )
          CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d       (1:npti), t_bo                 )
-         CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d    (1:npti), sprecip              ) 
+         CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d    (1:npti), sprecip              )
          CALL tab_2d_1d( npti, nptidx(1:npti), qsb_ice_bot_1d(1:npti), qsb_ice_bot          )
          CALL tab_2d_1d( npti, nptidx(1:npti), fhld_1d       (1:npti), fhld                 )
-         
+
          CALL tab_2d_1d( npti, nptidx(1:npti), qml_ice_1d    (1:npti), qml_ice    (:,:,kl) )
          CALL tab_2d_1d( npti, nptidx(1:npti), qcn_ice_1d    (1:npti), qcn_ice    (:,:,kl) )
@@ -471 +471 @@
          sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti)
          oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti)
-         
+
          CALL tab_1d_2d( npti, nptidx(1:npti), at_i_1d(1:npti), at_i             )
          CALL tab_1d_2d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i (:,:,kl)     )
@@ -532 +532 @@
          CALL tab_1d_2d( npti, nptidx(1:npti), dh_i_sum  (1:npti) , dh_i_sum_2d(:,:,kl) )
          CALL tab_1d_2d( npti, nptidx(1:npti), dh_s_mlt  (1:npti) , dh_s_mlt_2d(:,:,kl) )
-         ! SIMIP diagnostics         
+         ! SIMIP diagnostics
          CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d       (1:npti), t_si       (:,:,kl) )
          CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_bot_1d(1:npti), qcn_ice_bot(:,:,kl) )
@@ -554 +554 @@
    SUBROUTINE ice_thd_init
       !!-------------------------------------------------------------------
-      !!                   ***  ROUTINE ice_thd_init *** 
-      !!                 
+      !!                   ***  ROUTINE ice_thd_init ***
+      !!
       !! ** Purpose :   Physical constants and parameters associated with
       !!                ice thermodynamics

NEMO/trunk/src/ICE/icethd_dh.F90

@@ -2 +2 @@
    !!======================================================================
    !!                       ***  MODULE icethd_dh ***
-   !!   seaice : thermodynamic growth and melt 
+   !!   seaice : thermodynamic growth and melt
    !!======================================================================
    !! History :       !  2003-05  (M. Vancoppenolle) Original code in 1D
-   !!                 !  2005-06  (M. Vancoppenolle) 3D version 
+   !!                 !  2005-06  (M. Vancoppenolle) 3D version
    !!            4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
    !!----------------------------------------------------------------------
@@ -24 +24 @@
    USE lib_mpp        ! MPP library
    USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
-   
+
    IMPLICIT NONE
    PRIVATE
@@ -59 +59 @@
       !!
       !! References : Bitz and Lipscomb, 1999, J. Geophys. Res.
-      !!              Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646   
-      !!              Vancoppenolle, Fichefet and Bitz, 2005, Geophys. Res. Let. 
+      !!              Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646
+      !!              Vancoppenolle, Fichefet and Bitz, 2005, Geophys. Res. Let.
       !!              Vancoppenolle et al.,2009, Ocean Modelling
       !!------------------------------------------------------------------
@@ -67 +67 @@
 
       REAL(wp) ::   ztmelts      ! local scalar
-      REAL(wp) ::   zdum       
+      REAL(wp) ::   zdum
       REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment
       REAL(wp) ::   zswi1        ! switch for computation of bottom salinity
@@ -87 +87 @@
       REAL(wp), DIMENSION(jpij) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2)
       REAL(wp), DIMENSION(jpij) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2)
-      REAL(wp), DIMENSION(jpij) ::   zdeltah     
+      REAL(wp), DIMENSION(jpij) ::   zdeltah
       REAL(wp), DIMENSION(jpij) ::   zsnw        ! distribution of snow after wind blowing
 
-      INTEGER , DIMENSION(jpij,nlay_i)     ::   icount    ! number of layers vanishing by melting 
+      INTEGER , DIMENSION(jpij,nlay_i)     ::   icount    ! number of layers vanishing by melting
       REAL(wp), DIMENSION(jpij,0:nlay_i+1) ::   zh_i      ! ice layer thickness (m)
       REAL(wp), DIMENSION(jpij,0:nlay_s  ) ::   zh_s      ! snw layer thickness (m)
@@ -97 +97 @@
       REAL(wp) ::   zswitch_sal
 
-      INTEGER  ::   num_iter_max      ! Heat conservation 
+      INTEGER  ::   num_iter_max      ! Heat conservation
       !!------------------------------------------------------------------
 
@@ -149 +149 @@
       !
       DO ji = 1, npti
-         zf_tt(ji)         = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji) + qtr_ice_bot_1d(ji) * frq_m_1d(ji) 
+         zf_tt(ji)         = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji) + qtr_ice_bot_1d(ji) * frq_m_1d(ji)
          zq_bot(ji)        = MAX( 0._wp, zf_tt(ji) * rDt_ice )
       END DO
@@ -172 +172 @@
             END IF
          END DO
-      END DO         
+      END DO
 
       ! Snow precipitation
@@ -202 +202 @@
                zdum    = - rswitch * zq_top(ji) / MAX( ze_s(ji,jk), epsi20 )   ! thickness change
                zdum    = MAX( zdum , - zh_s(ji,jk) )                           ! bound melting
-               
+
                hfx_snw_1d    (ji) = hfx_snw_1d    (ji) - ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice   ! heat used to melt snow(W.m-2, >0)
                wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos        * zdum * a_i_1d(ji) * r1_Dt_ice   ! snow melting only = water into the ocean
-               
+
                ! updates available heat + thickness
                dh_s_mlt(ji)    =              dh_s_mlt(ji)    + zdum
@@ -217 +217 @@
       END DO
 
-      ! Snow sublimation 
+      ! Snow sublimation
       !-----------------
       ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates
@@ -225 +225 @@
       DO ji = 1, npti
          IF( evap_ice_1d(ji) > 0._wp ) THEN
-            zdeltah   (ji) = MAX( - evap_ice_1d(ji) * r1_rhos * rDt_ice, - h_s_1d(ji) )   ! amount of snw that sublimates, < 0            
+            zdeltah   (ji) = MAX( - evap_ice_1d(ji) * r1_rhos * rDt_ice, - h_s_1d(ji) )   ! amount of snw that sublimates, < 0
             zevap_rema(ji) = MAX( 0._wp, evap_ice_1d(ji) * rDt_ice + zdeltah(ji) * rhos ) ! remaining evap in kg.m-2 (used for ice sublimation later on)
          ENDIF
       END DO
-      
+
       DO jk = 0, nlay_s
          DO ji = 1, npti
@@ -247 +247 @@
       END DO
 
-      !      
+      !
       !                       ! ============ !
       !                       !     Ice      !
       !                       ! ============ !
 
-      ! Surface ice melting 
+      ! Surface ice melting
       !--------------------
       DO jk = 1, nlay_i
          DO ji = 1, npti
             ztmelts = - rTmlt * sz_i_1d(ji,jk)   ! Melting point of layer k [C]
-            
+
             IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN   !-- Internal melting
 
-               zEi            = - e_i_1d(ji,jk) * r1_rhoi             ! Specific enthalpy of layer k [J/kg, <0]       
+               zEi            = - e_i_1d(ji,jk) * r1_rhoi             ! Specific enthalpy of layer k [J/kg, <0]
                zdE            =   0._wp                               ! Specific enthalpy difference (J/kg, <0)
                !                                                          set up at 0 since no energy is needed to melt water...(it is already melted)
-               zdum           = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing     
+               zdum           = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing
                !                                                          this should normally not happen, but sometimes, heat diffusion leads to this
                zfmdt          = - zdum * rhoi                         ! Recompute mass flux [kg/m2, >0]
@@ -275 +275 @@
                !                                                                                          using s_i_1d and not sz_i_1d(jk) is ok
             ELSE                                        !-- Surface melting
-               
+
                zEi            = - e_i_1d(ji,jk) * r1_rhoi             ! Specific enthalpy of layer k [J/kg, <0]
                zEw            =    rcp * ztmelts                      ! Specific enthalpy of resulting meltwater [J/kg, <0]
                zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0
-               
+
                zfmdt          = - zq_top(ji) / zdE                    ! Mass flux to the ocean [kg/m2, >0]
-               
+
                zdum           = - zfmdt * r1_rhoi                     ! Melt of layer jk [m, <0]
-               
+
                zdum           = MIN( 0._wp , MAX( zdum , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0]
 
                zq_top(ji)     = MAX( 0._wp , zq_top(ji) - zdum * rhoi * zdE ) ! update available heat
-               
+
                dh_i_sum(ji)   = dh_i_sum(ji) + zdum                   ! Cumulate surface melt
-               
+
                zfmdt          = - rhoi * zdum                         ! Recompute mass flux [kg/m2, >0]
-               
+
                zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0]
-               
+
                hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw  * zfmdt             * a_i_1d(ji) * r1_Dt_ice    ! Heat flux [W.m-2], < 0
-               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zdE  * zfmdt             * a_i_1d(ji) * r1_Dt_ice    ! Heat flux used in this process [W.m-2], > 0  
+               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zdE  * zfmdt             * a_i_1d(ji) * r1_Dt_ice    ! Heat flux used in this process [W.m-2], > 0
                wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * zdum              * a_i_1d(ji) * r1_Dt_ice    ! Mass flux
                sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice    ! Salt flux >0
-               !                                                                                          using s_i_1d and not sz_i_1d(jk) is ok) 
+               !                                                                                          using s_i_1d and not sz_i_1d(jk) is ok)
             END IF
             ! update thickness
@@ -320 +320 @@
             !                                                                                                            if all ice is melted. => must be corrected
             ! update remaining mass flux and thickness
-            zevap_rema(ji) = zevap_rema(ji) + zdum * rhoi            
+            zevap_rema(ji) = zevap_rema(ji) + zdum * rhoi
             zh_i(ji,jk)    = MAX( 0._wp, zh_i(ji,jk) + zdum )
             h_i_1d(ji)     = MAX( 0._wp, h_i_1d(ji)  + zdum )
@@ -329 +329 @@
             h_i_old (ji,jk) = h_i_old (ji,jk) + zdum
 
-            ! record which layers have disappeared (for bottom melting) 
+            ! record which layers have disappeared (for bottom melting)
             !    => icount=0 : no layer has vanished
             !    => icount=5 : 5 layers have vanished
-            rswitch       = MAX( 0._wp , SIGN( 1._wp , - zh_i(ji,jk) ) ) 
+            rswitch       = MAX( 0._wp , SIGN( 1._wp , - zh_i(ji,jk) ) )
             icount(ji,jk) = NINT( rswitch )
-                        
-         END DO
-      END DO
-      
+
+         END DO
+      END DO
+
       ! remaining "potential" evap is sent to ocean
       DO ji = 1, npti
@@ -344 +344 @@
 
 
-      ! Ice Basal growth 
+      ! Ice Basal growth
       !------------------
       ! Basal growth is driven by heat imbalance at the ice-ocean interface,
-      ! between the inner conductive flux  (qcn_ice_bot), from the open water heat flux 
-      ! (fhld) and the sensible ice-ocean flux (qsb_ice_bot). 
-      ! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice 
+      ! between the inner conductive flux  (qcn_ice_bot), from the open water heat flux
+      ! (fhld) and the sensible ice-ocean flux (qsb_ice_bot).
+      ! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice
 
       ! If salinity varies in time, an iterative procedure is required, because
@@ -359 +359 @@
       num_iter_max = 1
       IF( nn_icesal == 2 )   num_iter_max = 5  ! salinity varying in time
-      
+
       DO ji = 1, npti
          IF(  zf_tt(ji) < 0._wp  ) THEN
@@ -366 +366 @@
                ! New bottom ice salinity (Cox & Weeks, JGR88 )
                !--- zswi1  if dh/dt < 2.0e-8
-               !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 
+               !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7
                !--- zswi2  if dh/dt > 3.6e-7
                zgrr     = MIN( 1.0e-3, MAX ( dh_i_bog(ji) * r1_Dt_ice , epsi10 ) )
@@ -380 +380 @@
 
                zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i)
-               
+
                zEi            = rcpi * ( zt_i_new - (ztmelts+rt0) ) &                                  ! Specific enthalpy of forming ice (J/kg, <0)
                   &             - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts
@@ -389 +389 @@
 
                dh_i_bog(ji)   = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) )
-               
+
             END DO
-            ! Contribution to Energy and Salt Fluxes                                    
+            ! Contribution to Energy and Salt Fluxes
             zfmdt = - rhoi * dh_i_bog(ji)                                                              ! Mass flux x time step (kg/m2, < 0)
-            
+
             hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw  * zfmdt                      * a_i_1d(ji) * r1_Dt_ice   ! Heat flux to the ocean [W.m-2], >0
-            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zdE  * zfmdt                      * a_i_1d(ji) * r1_Dt_ice   ! Heat flux used in this process [W.m-2], <0          
+            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zdE  * zfmdt                      * a_i_1d(ji) * r1_Dt_ice   ! Heat flux used in this process [W.m-2], <0
             wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * dh_i_bog(ji)               * a_i_1d(ji) * r1_Dt_ice   ! Mass flux, <0
             sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * s_i_new(ji) * a_i_1d(ji) * r1_Dt_ice   ! Salt flux, <0
@@ -415 +415 @@
       DO jk = nlay_i, 1, -1
          DO ji = 1, npti
-            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting 
+            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting
 
                ztmelts = - rTmlt * sz_i_1d(ji,jk)  ! Melting point of layer jk (C)
@@ -424 +424 @@
                   zdE            = 0._wp                         ! Specific enthalpy difference   (J/kg, <0)
                   !                                                  set up at 0 since no energy is needed to melt water...(it is already melted)
-                  zdum           = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing     
+                  zdum           = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing
                   !                                                  this should normally not happen, but sometimes, heat diffusion leads to this
                   dh_i_itm (ji)  = dh_i_itm(ji) + zdum
@@ -446 +446 @@
 
                   zdum           = MIN( 0._wp , MAX( zdum, - zh_i(ji,jk) ) )       ! bound thickness change
-                  
+
                   zq_bot(ji)     = MAX( 0._wp , zq_bot(ji) - zdum * rhoi * zdE )   ! update available heat. MAX is necessary for roundup errors
 
@@ -455 +455 @@
                   zQm            = zfmdt * zEw                                     ! Heat exchanged with ocean
 
-                  hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw  * zfmdt             * a_i_1d(ji) * r1_Dt_ice   ! Heat flux to the ocean [W.m-2], <0  
+                  hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw  * zfmdt             * a_i_1d(ji) * r1_Dt_ice   ! Heat flux to the ocean [W.m-2], <0
                   hfx_bom_1d(ji) = hfx_bom_1d(ji) - zdE  * zfmdt             * a_i_1d(ji) * r1_Dt_ice   ! Heat used in this process [W.m-2], >0
                   wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoi * zdum              * a_i_1d(ji) * r1_Dt_ice   ! Mass flux
@@ -488 +488 @@
          END DO
       END DO
-      
+
       ! Snow load on ice
       ! -----------------
@@ -511 +511 @@
          END DO
       END DO
-      
+
       ! Snow-Ice formation
       ! ------------------
-      ! When snow load exceeds Archimede's limit, snow-ice interface goes down under sea-level, 
+      ! When snow load exceeds Archimede's limit, snow-ice interface goes down under sea-level,
       ! flooding of seawater transforms snow into ice. Thickness that is transformed is dh_snowice (positive for the ice)
       z1_rho = 1._wp / ( rhos+rho0-rhoi )
@@ -528 +528 @@
          zfmdt          = ( rhos - rhoi ) * dh_snowice(ji)    ! <0
          zEw            = rcp * sst_1d(ji)
-         zQm            = zfmdt * zEw 
-         
+         zQm            = zfmdt * zEw
+
          hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw        * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux
          sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Salt flux
@@ -536 +536 @@
          IF( nn_icesal /= 2 )  THEN
             sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d(ji) * zfmdt                 * a_i_1d(ji) * r1_Dt_ice  &  ! put back sss_m     into the ocean
-               &                            - s_i_1d(ji) * dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice     ! and get  rn_icesal from the ocean 
+               &                            - s_i_1d(ji) * dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice     ! and get  rn_icesal from the ocean
          ENDIF
 
@@ -574 +574 @@
       !--------------------------------------------
       CALL snw_ent( zh_s, ze_s, e_s_1d )
-      
+
       ! recalculate t_s_1d from e_s_1d
       DO jk = 1, nlay_s
@@ -589 +589 @@
 
       ! --- ensure that a_i = 0 & h_s = 0 where h_i = 0 ---
-      WHERE( h_i_1d(1:npti) == 0._wp )   
+      WHERE( h_i_1d(1:npti) == 0._wp )
          a_i_1d (1:npti) = 0._wp
          h_s_1d (1:npti) = 0._wp
          t_su_1d(1:npti) = rt0
       END WHERE
-      
+
    END SUBROUTINE ice_thd_dh
 
@@ -602 +602 @@
       !!
       !! ** Purpose :
-      !!           This routine computes new vertical grids in the snow, 
-      !!           and consistently redistributes temperatures. 
+      !!           This routine computes new vertical grids in the snow,
+      !!           and consistently redistributes temperatures.
       !!           Redistribution is made so as to ensure to energy conservation
       !!
       !!
       !! ** Method  : linear conservative remapping
-      !!           
+      !!
       !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses
       !!            2) linear remapping on the new layers
@@ -637 +637 @@
       !  1) Cumulative integral of old enthalpy * thickness and layers interfaces
       !--------------------------------------------------------------------------
-      zeh_cum0(1:npti,0) = 0._wp 
+      zeh_cum0(1:npti,0) = 0._wp
       zh_cum0 (1:npti,0) = 0._wp
       DO jk0 = 1, nlay_s+1
@@ -651 +651 @@
       ! new layer thickesses
       DO ji = 1, npti
-         zhnew(ji) = SUM( ph_old(ji,0:nlay_s) ) * r1_nlay_s  
+         zhnew(ji) = SUM( ph_old(ji,0:nlay_s) ) * r1_nlay_s
       END DO
 
@@ -662 +662 @@
       END DO
 
-      zeh_cum1(1:npti,0:nlay_s) = 0._wp 
+      zeh_cum1(1:npti,0:nlay_s) = 0._wp
       ! new cumulative q*h => linear interpolation
       DO jk0 = 1, nlay_s+1
@@ -676 +676 @@
       END DO
       ! to ensure that total heat content is strictly conserved, set:
-      zeh_cum1(1:npti,nlay_s) = zeh_cum0(1:npti,nlay_s+1) 
+      zeh_cum1(1:npti,nlay_s) = zeh_cum0(1:npti,nlay_s+1)
 
       ! new enthalpies
       DO jk1 = 1, nlay_s
          DO ji = 1, npti
-            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) ) 
+            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) )
             pe_new(ji,jk1) = rswitch * ( zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 )
          END DO
       END DO
-      
+
    END SUBROUTINE snw_ent
 
-   
+
 #else
    !!----------------------------------------------------------------------

NEMO/trunk/src/ICE/icethd_pnd.F90

@@ -1 @@
-MODULE icethd_pnd 
+MODULE icethd_pnd
    !!======================================================================
    !!                     ***  MODULE  icethd_pnd   ***
@@ -41 +41 @@
    INTEGER, PARAMETER ::   np_pndTOPO = 3   ! Level ice pond scheme
 
-   !-------------------------------------------------------------------------- 
+   !--------------------------------------------------------------------------
    ! Diagnostics for pond volume per area
    !
@@ -56 +56 @@
    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_drn       ! pond volume lost by drainage     [-]
    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_lid       ! exchange with lid / refreezing   [-]
-   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_rnf       ! meltwater pond lost to runoff    [-]      
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_rnf       ! meltwater pond lost to runoff    [-]
    REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   diag_dvpn_mlt_1d    ! meltwater pond volume input      [-]
    REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   diag_dvpn_drn_1d    ! pond volume lost by drainage     [-]
@@ -75 +75 @@
       !!-------------------------------------------------------------------
       !!               ***  ROUTINE ice_thd_pnd   ***
-      !!               
+      !!
       !! ** Purpose :   change melt pond fraction and thickness
       !!
@@ -84 +84 @@
       INTEGER ::   ji, jj, jl        ! loop indices
       !!-------------------------------------------------------------------
-      
+
       ALLOCATE( diag_dvpn_mlt(jpi,jpj), diag_dvpn_lid(jpi,jpj), diag_dvpn_drn(jpi,jpj), diag_dvpn_rnf(jpi,jpj) )
       ALLOCATE( diag_dvpn_mlt_1d(jpij), diag_dvpn_lid_1d(jpij), diag_dvpn_drn_1d(jpij), diag_dvpn_rnf_1d(jpij) )
@@ -111 +111 @@
          END_2D
       END DO
-      
+
       !------------------------------
       !  Identify grid cells with ice
@@ -148 +148 @@
       DEALLOCATE( diag_dvpn_mlt   , diag_dvpn_lid   , diag_dvpn_drn   , diag_dvpn_rnf    )
       DEALLOCATE( diag_dvpn_mlt_1d, diag_dvpn_lid_1d, diag_dvpn_drn_1d, diag_dvpn_rnf_1d )
-      
-   END SUBROUTINE ice_thd_pnd 
-
-
-   SUBROUTINE pnd_CST 
+
+   END SUBROUTINE ice_thd_pnd
+
+
+   SUBROUTINE pnd_CST
       !!-------------------------------------------------------------------
       !!                ***  ROUTINE pnd_CST  ***
@@ -158 +158 @@
       !! ** Purpose :   Compute melt pond evolution
       !!
-      !! ** Method  :   Melt pond fraction and thickness are prescribed 
+      !! ** Method  :   Melt pond fraction and thickness are prescribed
       !!                to non-zero values when t_su = 0C
       !!
       !! ** Tunable parameters : pond fraction (rn_apnd), pond depth (rn_hpnd)
-      !!                
+      !!
       !! ** Note   : Coupling with such melt ponds is only radiative
       !!             Advection, ridging, rafting... are bypassed
@@ -172 +172 @@
       !!-------------------------------------------------------------------
       DO jl = 1, jpl
-         
+
          CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d    (1:npti), a_i    (:,:,jl) )
          CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d   (1:npti), t_su   (:,:,jl) )
@@ -185 +185 @@
             !
             IF( a_i_1d(ji) >= 0.01_wp .AND. t_su_1d(ji) >= rt0 ) THEN
-               h_ip_1d(ji)      = rn_hpnd    
+               h_ip_1d(ji)      = rn_hpnd
                a_ip_1d(ji)      = rn_apnd * a_i_1d(ji)
                h_il_1d(ji)      = 0._wp    ! no pond lids whatsoever
             ELSE
-               h_ip_1d(ji)      = 0._wp    
+               h_ip_1d(ji)      = 0._wp
                a_ip_1d(ji)      = 0._wp
                h_il_1d(ji)      = 0._wp
@@ -222 +222 @@
       !! ** Method  : A fraction of meltwater is accumulated in ponds and sent to ocean when surface is freezing
       !!              We  work with volumes and then redistribute changes into thickness and concentration
-      !!              assuming linear relationship between the two. 
+      !!              assuming linear relationship between the two.
       !!
       !! ** Action  : - pond growth:      Vp = Vp + dVmelt                                          --- from Holland et al 2012 ---
@@ -237 +237 @@
       !!                                     dH = lid thickness change. Retrieved from this eq.:    --- from Flocco et al 2010 ---
       !!
-      !!                                                                   rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H 
+      !!                                                                   rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H
       !!                                                                      H = lid thickness
       !!                                                                      Lf = latent heat of fusion
@@ -260 +260 @@
       !!
       !! ** Tunable parameters : rn_apnd_max, rn_apnd_min, rn_pnd_flush
-      !! 
-      !! ** Note       :   Mostly stolen from CICE but not only. These are between level-ice ponds and CESM ponds. 
+      !!
+      !! ** Note       :   Mostly stolen from CICE but not only. These are between level-ice ponds and CESM ponds.
       !!
       !! ** References :   Flocco and Feltham (JGR, 2007)
@@ -267 +267 @@
       !!                   Holland et al      (J. Clim, 2012)
       !!                   Hunke et al        (OM 2012)
-      !!-------------------------------------------------------------------  
+      !!-------------------------------------------------------------------
       REAL(wp), DIMENSION(nlay_i) ::   ztmp           ! temporary array
       !!
@@ -287 +287 @@
       INTEGER  ::   ji, jk, jl                        ! loop indices
       !!-------------------------------------------------------------------
-      z1_rhow   = 1._wp / rhow 
+      z1_rhow   = 1._wp / rhow
       z1_aspect = 1._wp / zaspect
-      z1_Tp     = 1._wp / zTp 
-      
+      z1_Tp     = 1._wp / zTp
+
       CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d          (1:npti), at_i          )
       CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d       (1:npti), wfx_pnd       )
-      
+
       CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_mlt_1d (1:npti), diag_dvpn_mlt )
       CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_drn_1d (1:npti), diag_dvpn_drn )
@@ -315 +315 @@
             CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,jl) )
          END DO
-         
+
          !-----------------------
          ! Melt pond calculations
@@ -342 +342 @@
                zdv_avail = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) ! > 0
                zfr_mlt   = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) !  = ( 1 - r ) = fraction of melt water that is not flushed
-               zdv_mlt   = MAX( 0._wp, zfr_mlt * zdv_avail ) ! max for roundoff errors? 
+               zdv_mlt   = MAX( 0._wp, zfr_mlt * zdv_avail ) ! max for roundoff errors?
                !
                !--- overflow ---!
@@ -349 +349 @@
                !    If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume
                !       a_ip_max = zfr_mlt * a_i
-               !       => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as: 
+               !       => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:
                zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect
                zdv_mlt   = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) )
@@ -356 +356 @@
                !    If pond depth exceeds half the ice thickness then reduce the pond volume
                !       h_ip_max = 0.5 * h_i
-               !       => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as: 
+               !       => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:
                zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji)
                zdv_mlt   = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) )
@@ -375 +375 @@
                IF( ln_pnd_lids ) THEN
                   !
-                  !--- Lid growing and subsequent pond shrinking ---! 
+                  !--- Lid growing and subsequent pond shrinking ---!
                   zdv_frz = - 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0
                      &                    SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rDt_ice / (rLfus * rhow) ) ) ! max for roundoff errors
@@ -386 +386 @@
 
                ELSE
-                  zdv_frz = v_ip_1d(ji) * ( EXP( 0.01_wp * zdT * z1_Tp ) - 1._wp )  ! Holland 2012 (eq. 6) 
+                  zdv_frz = v_ip_1d(ji) * ( EXP( 0.01_wp * zdT * z1_Tp ) - 1._wp )  ! Holland 2012 (eq. 6)
                   ! Pond shrinking
                   v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zdv_frz )
@@ -398 +398 @@
                !
 
-               !------------------------------------------------!            
+               !------------------------------------------------!
                ! Pond drainage through brine network (flushing) !
                !------------------------------------------------!
@@ -420 +420 @@
                ! Do the drainage using Darcy's law
                zdv_flush   = -zperm * rho0 * grav * zhp * rDt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) * rn_pnd_flush ! zflush comes from Hunke et al. (2012)
-               zdv_flush   = MAX( zdv_flush, -v_ip_1d(ji) ) ! < 0 
+               zdv_flush   = MAX( zdv_flush, -v_ip_1d(ji) ) ! < 0
                v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush
 
@@ -479 +479 @@
 
 
-   SUBROUTINE pnd_TOPO    
-                                         
+   SUBROUTINE pnd_TOPO
+
       !!-------------------------------------------------------------------
       !!                ***  ROUTINE pnd_TOPO  ***
@@ -488 +488 @@
       !!
       !! ** Method  :   This code is initially based on Flocco and Feltham
-      !!                (2007) and Flocco et al. (2010). 
+      !!                (2007) and Flocco et al. (2010).
       !!
       !!                - Calculate available pond water base on surface meltwater
@@ -532 +532 @@
       REAL(wp), DIMENSION(jpi,jpj) ::   zvolp, &     !! total melt pond water available before redistribution and drainage
                                         zvolp_res    !! remaining melt pond water available after drainage
-                                        
+
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_a_i
 
@@ -545 +545 @@
 
       CALL ctl_stop( 'STOP', 'icethd_pnd : topographic melt ponds are still an ongoing work' )
-      
+
       !---------------------------------------------------------------
       ! Initialise
@@ -553 +553 @@
       zrhoi_L   = rhoi * rLfus      ! volumetric latent heat (J/m^3)
       zTp       = rt0 - 0.15_wp          ! pond freezing point, slightly below 0C (ponds are bid saline)
-      z1_rhow   = 1._wp / rhow 
+      z1_rhow   = 1._wp / rhow
 
       ! Set required ice variables (hard-coded here for now)
-!      zfpond(:,:) = 0._wp          ! contributing freshwater flux (?) 
-      
+!      zfpond(:,:) = 0._wp          ! contributing freshwater flux (?)
+
       at_i (:,:) = SUM( a_i (:,:,:), dim=3 ) ! ice fraction
       vt_i (:,:) = SUM( v_i (:,:,:), dim=3 ) ! volume per grid area
       vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 ) ! pond volume per grid area
       vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) ! lid volume per grid area
-      
+
       ! thickness
       WHERE( a_i(:,:,:) > epsi20 )   ;   z1_a_i(:,:,:) = 1._wp / a_i(:,:,:)
@@ -568 +568 @@
       END WHERE
       h_i(:,:,:) = v_i (:,:,:) * z1_a_i(:,:,:)
-      
+
       !---------------------------------------------------------------
       ! Change 2D to 1D
       !---------------------------------------------------------------
-      ! MV 
+      ! MV
       ! a less computing-intensive version would have 2D-1D passage here
       ! use what we have in iceitd.F90 (incremental remapping)
@@ -582 +582 @@
       ! Holland et al (2012) suggest that the fraction of runoff decreases with total ice fraction
       ! I cite her words, they are very talkative
-      ! "grid cells with very little ice cover (and hence more open water area) 
+      ! "grid cells with very little ice cover (and hence more open water area)
       ! have a higher runoff fraction to rep- resent the greater proximity of ice to open water."
       ! "This results in the same runoff fraction r for each ice category within a grid cell"
-      
+
       zvolp(:,:) = 0._wp
 
       DO jl = 1, jpl
          DO_2D( 1, 1, 1, 1 )
-                 
+
                IF ( a_i(ji,jj,jl) > epsi10 ) THEN
-            
+
                   !--- Available and contributing meltwater for melt ponding ---!
                   zv_mlt  = - ( dh_i_sum_2d(ji,jj,jl) * rhoi + dh_s_mlt_2d(ji,jj,jl) * rhos ) &        ! available volume of surface melt water per grid area
@@ -601 +601 @@
 
                   diag_dvpn_mlt(ji,jj) = diag_dvpn_mlt(ji,jj) + zv_mlt * r1_Dt_ice                     ! diags
-                  diag_dvpn_rnf(ji,jj) = diag_dvpn_rnf(ji,jj) + ( 1. - zfr_mlt ) * zv_mlt * r1_Dt_ice   
+                  diag_dvpn_rnf(ji,jj) = diag_dvpn_rnf(ji,jj) + ( 1. - zfr_mlt ) * zv_mlt * r1_Dt_ice
 
                   !--- Create possible new ponds
@@ -610 +610 @@
                      a_ip_frac(ji,jj,jl)  = 1.0_wp    ! pond fraction of sea ice (apnd for CICE)
                   ENDIF
-                  
+
                   !--- Deepen existing ponds with no change in pond fraction, before redistribution and drainage
                   v_ip(ji,jj,jl) = v_ip(ji,jj,jl) +  zv_pnd                                            ! use pond water to increase thickness
                   h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl)
-                  
+
                   !--- Total available pond water volume (pre-existing + newly produced)j
-                  zvolp(ji,jj)   = zvolp(ji,jj)   + v_ip(ji,jj,jl) 
+                  zvolp(ji,jj)   = zvolp(ji,jj)   + v_ip(ji,jj,jl)
 !                 zfpond(ji,jj) = zfpond(ji,jj) + zpond * a_ip_frac(ji,jj,jl) ! useless for now
-                   
+
                ENDIF ! a_i
 
          END_2D
       END DO ! ji
-                  
+
       !--------------------------------------------------------------
       ! Redistribute and drain water from ponds
-      !--------------------------------------------------------------   
+      !--------------------------------------------------------------
       CALL ice_thd_pnd_area( zvolp, zvolp_res )
-                                   
+
       !--------------------------------------------------------------
       ! Melt pond lid growth and melt
-      !--------------------------------------------------------------   
-      
+      !--------------------------------------------------------------
+
       IF( ln_pnd_lids ) THEN
 
@@ -638 +638 @@
 
             IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. vt_ip(ji,jj) > zvp_min * at_i(ji,jj) ) THEN
-                  
+
                !--------------------------
                ! Pond lid growth and melt
@@ -648 +648 @@
                END DO
                zTavg = zTavg / a_i(ji,jj,jl) !!! could get a division by zero here
-         
+
                DO jl = 1, jpl-1
-            
+
                   IF ( v_il(ji,jj,jl) > epsi10 ) THEN
-               
+
                      !----------------------------------------------------------------
                      ! Lid melting: floating upper ice layer melts in whole or part
@@ -660 +660 @@
 
                         zdvice = MIN( dh_i_sum_2d(ji,jj,jl)*a_ip(ji,jj,jl), v_il(ji,jj,jl) )
-                        
+
                         IF ( zdvice > epsi10 ) THEN
-                        
+
                            v_il (ji,jj,jl) = v_il (ji,jj,jl)   - zdvice
-                           v_ip(ji,jj,jl)  = v_ip(ji,jj,jl)    + zdvice ! MV: not sure i understand dh_i_sum seems counted twice - 
+                           v_ip(ji,jj,jl)  = v_ip(ji,jj,jl)    + zdvice ! MV: not sure i understand dh_i_sum seems counted twice -
                                                                         ! as it is already counted in surface melt
 !                          zvolp(ji,jj)     = zvolp(ji,jj)     + zdvice ! pointless to calculate total volume (done in icevar)
 !                          zfpond(ji,jj)    = fpond(ji,jj)     + zdvice ! pointless to follow fw budget (ponds have no fw)
-                     
+
                            IF ( v_il(ji,jj,jl) < epsi10 .AND. v_ip(ji,jj,jl) > epsi10) THEN
                            ! ice lid melted and category is pond covered
-                              v_ip(ji,jj,jl)  = v_ip(ji,jj,jl)  + v_il(ji,jj,jl) 
-!                             zfpond(ji,jj)    = zfpond (ji,jj)    + v_il(ji,jj,jl) 
+                              v_ip(ji,jj,jl)  = v_ip(ji,jj,jl)  + v_il(ji,jj,jl)
+!                             zfpond(ji,jj)    = zfpond (ji,jj)    + v_il(ji,jj,jl)
                               v_il(ji,jj,jl)   = 0._wp
                            ENDIF
                            h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) !!! could get a division by zero here
-                           
+
                            diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) + zdvice   ! diag
-                           
+
                         ENDIF
-                        
+
                      !----------------------------------------------------------------
-                     ! Freeze pre-existing lid 
+                     ! Freeze pre-existing lid
                      !----------------------------------------------------------------
 
@@ -688 +688 @@
 
                         ! differential growth of base of surface floating ice layer
-                        zdTice = MAX( - t_su(ji,jj,jl) - zTd , 0._wp ) ! > 0   
+                        zdTice = MAX( - t_su(ji,jj,jl) - zTd , 0._wp ) ! > 0
                         zomega = rcnd_i * zdTice / zrhoi_L
                         zdHui  = SQRT( 2._wp * zomega * rDt_ice + ( v_il(ji,jj,jl) / a_i(ji,jj,jl) )**2 ) &
                                - v_il(ji,jj,jl) / a_i(ji,jj,jl)
                         zdvice = min( zdHui*a_ip(ji,jj,jl) , v_ip(ji,jj,jl) )
-                  
+
                         IF ( zdvice > epsi10 ) THEN
                            v_il (ji,jj,jl)  = v_il(ji,jj,jl)   + zdvice
@@ -700 +700 @@
 !                          zfpond(ji,jj)   = zfpond(ji,jj)    - zdvice
                            h_ip(ji,jj,jl)   = v_ip(ji,jj,jl) / a_ip(ji,jj,jl)
-                           
+
                            diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) - zdvice    ! diag
-                           
+
                         ENDIF
-                  
+
                      ENDIF ! Tsfcn(i,j,n)
 
@@ -714 +714 @@
 
                   ELSE ! v_il < epsi10
-                    
+
                      ! thickness of newly formed ice
                      ! the surface temperature of a meltpond is the same as that
-                     ! of the ice underneath (0C), and the thermodynamic surface 
+                     ! of the ice underneath (0C), and the thermodynamic surface
                      ! flux is the same
-                     
+
                      !!! we need net surface energy flux, excluding conduction
                      !!! fsurf is summed over categories in CICE
                      !!! we have the category-dependent flux, let us use it ?
-                     zfsurf = qns_ice(ji,jj,jl) + qsr_ice(ji,jj,jl)                     
+                     zfsurf = qns_ice(ji,jj,jl) + qsr_ice(ji,jj,jl)
                      zdHui  = MAX ( -zfsurf * rDt_ice/zrhoi_L , 0._wp )
                      zdvice = MIN ( zdHui * a_ip(ji,jj,jl) , v_ip(ji,jj,jl) )
@@ -729 +729 @@
                         v_il (ji,jj,jl)  = v_il(ji,jj,jl)   + zdvice
                         v_ip(ji,jj,jl)   = v_ip(ji,jj,jl)   - zdvice
-                        
+
                         diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) - zdvice      ! diag
 !                       zvolp(ji,jj)     = zvolp(ji,jj)     - zdvice
@@ -735 +735 @@
                         h_ip(ji,jj,jl)   = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) ! MV - in principle, this is useless as h_ip is computed in icevar
                      ENDIF
-               
+
                   ENDIF  ! v_il
-            
+
                END DO ! jl
 
@@ -745 +745 @@
                v_il(ji,jj,:) = 0._wp
 !              zfpond(ji,jj) = zfpond(ji,jj)- zvolp(ji,jj)
-!                 zvolp(ji,jj)    = 0._wp         
+!                 zvolp(ji,jj)    = 0._wp
 
             ENDIF
@@ -769 +769 @@
 !                 v_il(ji,jj,jl) = 0._wp ! probably uselesss now since we get zap_small
 !              ENDIF
-      
+
                ! recalculate equivalent pond variables
                IF ( a_ip(ji,jj,jl) > epsi10) THEN
@@ -779 +779 @@
 !                 h_il(ji,jj,jl)      = 0._wp ! MV in principle, useless as omputed in icevar
 !              ENDIF
-               
+
          END_2D
 
@@ -787 +787 @@
    END SUBROUTINE pnd_TOPO
 
-   
+
    SUBROUTINE ice_thd_pnd_area( zvolp , zdvolp )
 
@@ -793 +793 @@
        !!                ***  ROUTINE ice_thd_pnd_area ***
        !!
-       !! ** Purpose : Given the total volume of available pond water, 
+       !! ** Purpose : Given the total volume of available pond water,
        !!              redistribute and drain water
        !!
@@ -823 +823 @@
        !!
        !!------------------------------------------------------------------
-       
+
        REAL (wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: &
           zvolp,                                       &  ! total available pond water
@@ -865 +865 @@
        a_ip(:,:,:) = 0._wp
        h_ip(:,:,:) = 0._wp
- 
+
        DO_2D( 1, 1, 1, 1 )
- 
+
              IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp(ji,jj) > zvp_min * at_i(ji,jj) ) THEN
- 
+
         !-------------------------------------------------------------------
         ! initialize
         !-------------------------------------------------------------------
- 
+
         DO jl = 1, jpl
- 
+
            !----------------------------------------
            ! compute the effective snow fraction
            !----------------------------------------
- 
+
            IF (a_i(ji,jj,jl) < epsi10)  THEN
               hicen(jl) =  0._wp
@@ -889 +889 @@
               hsnon(jl) = v_s(ji,jj,jl) / a_i(ji,jj,jl)
               reduced_aicen(jl) = 1._wp ! n=jpl
- 
+
               !js: initial code in NEMO_DEV
               !IF (n < jpl) reduced_aicen(jl) = aicen(jl) &
               !                     * (-0.024_wp*hicen(jl) + 0.832_wp)
- 
+
               !js: from CICE 5.1.2: this limit reduced_aicen to 0.2 when hicen is too large
-              IF (jl < jpl) reduced_aicen(jl) = a_i(ji,jj,jl) & 
+              IF (jl < jpl) reduced_aicen(jl) = a_i(ji,jj,jl) &
                                    * max(0.2_wp,(-0.024_wp*hicen(jl) + 0.832_wp))
- 
+
               asnon(jl) = reduced_aicen(jl)  ! effective snow fraction (empirical)
               ! MV should check whether this makes sense to have the same effective snow fraction in here
               ! OLI: it probably doesn't
            END IF
- 
+
   ! This choice for alfa and beta ignores hydrostatic equilibium of categories.
   ! Hydrostatic equilibium of the entire ITD is accounted for below, assuming
@@ -911 +911 @@
   ! alfan = 60% of the ice volume) in each category lies above the reference line,
   ! and 40% below. Note: p6 is an arbitrary choice, but alfa+beta=1 is required.
- 
+
   ! MV:
   ! Note that this choice is not in the original FF07 paper and has been adopted in CICE
   ! No reason why is explained in the doc, but I guess there is a reason. I'll try to investigate, maybe
- 
+
   ! Where does that choice come from ? => OLI : Coz' Chuck Norris said so...
- 
+
            alfan(jl) = 0.6 * hicen(jl)
            betan(jl) = 0.4 * hicen(jl)
- 
+
            cum_max_vol(jl)     = 0._wp
            cum_max_vol_tmp(jl) = 0._wp
- 
+
         END DO ! jpl
- 
+
         cum_max_vol_tmp(0) = 0._wp
         drain = 0._wp
         zdvolp(ji,jj) = 0._wp
- 
+
         !----------------------------------------------------------
         ! Drain overflow water, update pond fraction and volume
         !----------------------------------------------------------
- 
+
         !--------------------------------------------------------------------------
         ! the maximum amount of water that can be contained up to each ice category
@@ -940 +940 @@
         ! Then the excess volume cum_max_vol(jl) drains out of the system
         ! It should be added to wfx_pnd_out
- 
+
         DO jl = 1, jpl-1 ! last category can not hold any volume
- 
+
            IF (alfan(jl+1) >= alfan(jl) .AND. alfan(jl+1) > 0._wp ) THEN
- 
+
               ! total volume in level including snow
               cum_max_vol_tmp(jl) = cum_max_vol_tmp(jl-1) + &
                  (alfan(jl+1) - alfan(jl)) * sum(reduced_aicen(1:jl))
- 
+
               ! subtract snow solid volumes from lower categories in current level
               DO ns = 1, jl
@@ -956 +956 @@
                       max(min(hsnon(ns)+alfan(ns)-alfan(jl), alfan(jl+1)-alfan(jl)), 0._wp)
               END DO
- 
+
            ELSE ! assume higher categories unoccupied
               cum_max_vol_tmp(jl) = cum_max_vol_tmp(jl-1)
@@ -966 +966 @@
         cum_max_vol_tmp(jpl) = cum_max_vol_tmp(jpl-1)  ! last category holds no volume
         cum_max_vol  (1:jpl) = cum_max_vol_tmp(1:jpl)
- 
+
         !----------------------------------------------------------------
         ! is there more meltwater than can be held in the floe?
@@ -973 +973 @@
            drain = zvolp(ji,jj) - cum_max_vol(jpl) + epsi10
            zvolp(ji,jj) = zvolp(ji,jj) - drain ! update meltwater volume available
- 
+
            diag_dvpn_rnf(ji,jj) = - drain      ! diag - overflow counted in the runoff part (arbitrary choice)
-           
+
            zdvolp(ji,jj) = drain         ! this is the drained water
            IF (zvolp(ji,jj) < epsi10) THEN
@@ -982 +982 @@
            END IF
         END IF
- 
+
         ! height and area corresponding to the remaining volume
         ! routine leaves zvolp unchanged
         CALL ice_thd_pnd_depth(reduced_aicen, asnon, hsnon, alfan, zvolp(ji,jj), cum_max_vol, hpond, m_index)
- 
+
         DO jl = 1, m_index
            !h_ip(jl) = hpond - alfan(jl) + alfan(1) ! here oui choulde update
@@ -996 +996 @@
         END DO
         !zapond = sum(a_ip(1:m_index))     !js: from CICE 5.1.2; not in Icepack1.1.0-6-gac6195d
- 
+
         !------------------------------------------------------------------------
         ! Drainage through brine network (permeability)
         !------------------------------------------------------------------------
         !!! drainage due to ice permeability - Darcy's law
- 
+
         ! sea water level
-        msno = 0._wp 
+        msno = 0._wp
         DO jl = 1 , jpl
           msno = msno + v_s(ji,jj,jl) * rhos
@@ -1010 +1010 @@
         hsl_rel = floe_weight / rho0 &
                 - ( ( sum(betan(:)*a_i(ji,jj,:)) / at_i(ji,jj) ) + alfan(1) )
- 
+
         deltah = hpond - hsl_rel
         pressure_head = grav * rho0 * max(deltah, 0._wp)
- 
+
         ! drain if ice is permeable
         permflag = 0
- 
+
         IF (pressure_head > 0._wp) THEN
            DO jl = 1, jpl-1
               IF ( hicen(jl) /= 0._wp ) THEN
- 
+
               !IF (hicen(jl) > 0._wp) THEN           !js: from CICE 5.1.2
- 
+
                  perm = 0._wp ! MV ugly dummy patch
-                 CALL ice_thd_pnd_perm(t_i(ji,jj,:,jl),  sz_i(ji,jj,:,jl), perm) ! bof 
+                 CALL ice_thd_pnd_perm(t_i(ji,jj,:,jl),  sz_i(ji,jj,:,jl), perm) ! bof
                  IF (perm > 0._wp) permflag = 1
- 
+
                  drain = perm*a_ip(ji,jj,jl)*pressure_head*rDt_ice / &
                                           (viscosity*hicen(jl))
                  zdvolp(ji,jj) = zdvolp(ji,jj) + min(drain, zvolp(ji,jj))
                  zvolp(ji,jj) = max(zvolp(ji,jj) - drain, 0._wp)
- 
+
                  diag_dvpn_drn(ji,jj) = - drain ! diag (could be better coded)
-                 
+
                  IF (zvolp(ji,jj) < epsi10) THEN
                     zdvolp(ji,jj) = zdvolp(ji,jj) + zvolp(ji,jj)
@@ -1040 +1040 @@
              END IF
           END DO
- 
+
            ! adjust melt pond dimensions
            IF (permflag > 0) THEN
@@ -1052 +1052 @@
            END IF
         END IF ! pressure_head
- 
+
         !-------------------------------
         ! remove water from the snow
@@ -1060 +1060 @@
         ! snow in melt ponds is not melted
         !------------------------------------------------------------------------
-        
+
         ! MV here, it seems that we remove some meltwater from the ponds, but I can't really tell
         ! how much, so I did not diagnose it
         ! so if there is a problem here, nobody is going to see it...
-        
- 
+
+
         ! Calculate pond volume for lower categories
         DO jl = 1,m_index-1
@@ -1071 +1071 @@
                           - (rhos/rhow) * asnon(jl) * min(hsnon(jl), h_ip(ji,jj,jl))
         END DO
- 
+
         ! Calculate pond volume for highest category = remaining pond volume
- 
+
         ! The following is completely unclear to Martin at least
         ! Could we redefine properly and recode in a more readable way ?
- 
+
         ! m_index = last category with melt pond
- 
+
         IF (m_index == 1) v_ip(ji,jj,m_index) = zvolp(ji,jj) ! volume of mw in 1st category is the total volume of melt water
- 
+
         IF (m_index > 1) THEN
           IF (zvolp(ji,jj) > sum( v_ip(ji,jj,1:m_index-1))) THEN
              v_ip(ji,jj,m_index) = zvolp(ji,jj) - sum(v_ip(ji,jj,1:m_index-1))
           ELSE
-             v_ip(ji,jj,m_index) = 0._wp 
+             v_ip(ji,jj,m_index) = 0._wp
              h_ip(ji,jj,m_index) = 0._wp
              a_ip(ji,jj,m_index) = 0._wp
@@ -1094 +1094 @@
           END IF
         END IF
- 
+
         DO jl = 1,m_index
            IF (a_ip(ji,jj,jl) > epsi10) THEN
@@ -1100 +1100 @@
            ELSE
               zdvolp(ji,jj) = zdvolp(ji,jj) + v_ip(ji,jj,jl)
-              h_ip(ji,jj,jl) = 0._wp 
+              h_ip(ji,jj,jl) = 0._wp
               v_ip(ji,jj,jl)  = 0._wp
               a_ip(ji,jj,jl) = 0._wp
@@ -1106 +1106 @@
         END DO
         DO jl = m_index+1, jpl
-           h_ip(ji,jj,jl) = 0._wp 
-           a_ip(ji,jj,jl) = 0._wp 
-           v_ip(ji,jj,jl) = 0._wp 
+           h_ip(ji,jj,jl) = 0._wp
+           a_ip(ji,jj,jl) = 0._wp
+           v_ip(ji,jj,jl) = 0._wp
         END DO
-        
+
            ENDIF
 
@@ -1319 +1319 @@
 
        DO k = 1, nlay_i
-       
+
           Sbr    = - Tin(k) / rTmlt ! Consistent expression with SI3 (linear liquidus)
           ! Best expression to date is that one (Vancoppenolle et al JGR 2019)
           ! Sbr  = - 18.7 * Tin(k) - 0.519 * Tin(k)**2 - 0.00535 * Tin(k) **3
           phi(k) = salin(k) / Sbr
-          
+
        END DO
 
@@ -1335 +1335 @@
    END SUBROUTINE ice_thd_pnd_perm
 
-   SUBROUTINE ice_thd_pnd_init 
+   SUBROUTINE ice_thd_pnd_init
       !!-------------------------------------------------------------------
       !!                  ***  ROUTINE ice_thd_pnd_init   ***
@@ -1342 +1342 @@
       !!              over sea ice
       !!
-      !! ** Method  :  Read the namthd_pnd  namelist and check the melt pond  
+      !! ** Method  :  Read the namthd_pnd  namelist and check the melt pond
       !!               parameter values called at the first timestep (nit000)
       !!
-      !! ** input   :   Namelist namthd_pnd  
+      !! ** input   :   Namelist namthd_pnd
       !!-------------------------------------------------------------------
       INTEGER  ::   ios, ioptio   ! Local integer
@@ -1389 +1389 @@
       !
       SELECT CASE( nice_pnd )
-      CASE( np_pndNO )         
+      CASE( np_pndNO )
          IF( ln_pnd_alb  ) THEN ; ln_pnd_alb  = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' )  ; ENDIF
          IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when no ponds' ) ; ENDIF
-      CASE( np_pndCST )         
+      CASE( np_pndCST )
          IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when constant ponds' ) ; ENDIF
       END SELECT
       !
    END SUBROUTINE ice_thd_pnd_init
-   
+
 #else
    !!----------------------------------------------------------------------
    !!   Default option          Empty module          NO SI3 sea-ice model
    !!----------------------------------------------------------------------
-#endif 
+#endif
 
    !!======================================================================
-END MODULE icethd_pnd 
+END MODULE icethd_pnd

NEMO/trunk/src/ICE/icethd_zdf_bl99.F90

@@ -2 +2 @@
    !!======================================================================
    !!                       ***  MODULE icethd_zdf_BL99 ***
-   !!   sea-ice: vertical heat diffusion in sea ice (computation of temperatures) 
+   !!   sea-ice: vertical heat diffusion in sea ice (computation of temperatures)
    !!======================================================================
    !! History :       !  2003-02  (M. Vancoppenolle) original 1D code
@@ -15 +15 @@
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants (ocean directory) 
+   USE phycst         ! physical constants (ocean directory)
    USE ice            ! sea-ice: variables
    USE ice1D          ! sea-ice: thermodynamics variables
@@ -44 +44 @@
       !!
       !! ** Method  : solves the heat equation diffusion with a Neumann boundary
-      !!              condition at the surface and a Dirichlet one at the bottom. 
+      !!              condition at the surface and a Dirichlet one at the bottom.
       !!              Solar radiation is partially absorbed into the ice.
-      !!              The specific heat and thermal conductivities depend on ice 
-      !!              salinity and temperature to take into account brine pocket   
+      !!              The specific heat and thermal conductivities depend on ice
+      !!              salinity and temperature to take into account brine pocket
       !!              melting. The numerical scheme is an iterative Crank-Nicolson
       !!              on a non-uniform multilayer grid in the ice and snow system.
@@ -91 +91 @@
       REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13)
       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 at 0C 
-      REAL(wp) ::   zdti_bnd  =  1.e-4_wp     ! maximal authorized error on temperature 
-      REAL(wp) ::   zhs_ssl   =  0.03_wp      ! surface scattering layer in the snow 
+      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered at 0C
+      REAL(wp) ::   zdti_bnd  =  1.e-4_wp     ! maximal authorized error on temperature
+      REAL(wp) ::   zhs_ssl   =  0.03_wp      ! surface scattering layer in the snow
       REAL(wp) ::   zhi_ssl   =  0.10_wp      ! surface scattering layer in the ice
       REAL(wp) ::   zh_min    =  1.e-3_wp     ! minimum ice/snow thickness for conduction
       REAL(wp) ::   ztmelts                   ! ice melting temperature
-      REAL(wp) ::   zdti_max                  ! current maximal error on temperature 
+      REAL(wp) ::   zdti_max                  ! current maximal error on temperature
       REAL(wp) ::   zcpi                      ! Ice specific heat
       REAL(wp) ::   zhfx_err, zdq             ! diag errors on heat
@@ -127 +127 @@
       REAL(wp), DIMENSION(jpij)          ::   zq_ini      ! diag errors on heat
       REAL(wp), DIMENSION(jpij)          ::   zghe        ! G(he), th. conduct enhancement factor, mono-cat
-      REAL(wp), DIMENSION(jpij)          ::   za_s_fra    ! ice fraction covered by snow 
-      REAL(wp), DIMENSION(jpij)          ::   isnow       ! snow presence (1) or not (0) 
-      REAL(wp), DIMENSION(jpij)          ::   isnow_comb  ! snow presence for met-office 
+      REAL(wp), DIMENSION(jpij)          ::   za_s_fra    ! ice fraction covered by snow
+      REAL(wp), DIMENSION(jpij)          ::   isnow       ! snow presence (1) or not (0)
+      REAL(wp), DIMENSION(jpij)          ::   isnow_comb  ! snow presence for met-office
       REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1)   ::   zindterm    ! 'Ind'ependent term
       REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1)   ::   zindtbis    ! Temporary 'ind'ependent term
@@ -139 +139 @@
       REAL(wp) ::   zhe        ! dummy factor
       REAL(wp) ::   zcnd_i     ! mean sea ice thermal conductivity
-      !!------------------------------------------------------------------     
+      !!------------------------------------------------------------------
 
       ! --- diag error on heat diffusion - PART 1 --- !
       DO ji = 1, npti
          zq_ini(ji) = ( SUM( e_i_1d(ji,1:nlay_i) ) * h_i_1d(ji) * r1_nlay_i +  &
-            &           SUM( e_s_1d(ji,1:nlay_s) ) * h_s_1d(ji) * r1_nlay_s ) 
+            &           SUM( e_s_1d(ji,1:nlay_s) ) * h_s_1d(ji) * r1_nlay_s )
       END DO
 
       ! calculate ice fraction covered by snow for radiation
       CALL ice_var_snwfra( h_s_1d(1:npti), za_s_fra(1:npti) )
-      
+
       !------------------
       ! 1) Initialization
@@ -155 +155 @@
       !
       ! extinction radiation in the snow
-      IF    ( nn_qtrice == 0 ) THEN   ! constant 
+      IF    ( nn_qtrice == 0 ) THEN   ! constant
          zraext_s(1:npti) = rn_kappa_s
       ELSEIF( nn_qtrice == 1 ) THEN   ! depends on melting/freezing conditions
@@ -166 +166 @@
       DO ji = 1, npti
          ! ice thickness
-         IF( h_i_1d(ji) > 0._wp ) THEN 
+         IF( h_i_1d(ji) > 0._wp ) THEN
             zh_i  (ji) = MAX( zh_min , h_i_1d(ji) ) * r1_nlay_i ! set a minimum thickness for conduction
             z1_h_i(ji) = 1._wp / zh_i(ji)                       !       it must be very small
@@ -198 +198 @@
          ztsuold    (1:npti) = t_su_1d(1:npti)                          ! surface temperature initial value
          t_su_1d    (1:npti) = MIN( t_su_1d(1:npti), rt0 - ztsu_err )   ! required to leave the choice between melting or not
-         zdqns_ice_b(1:npti) = dqns_ice_1d(1:npti)                      ! derivative of incoming nonsolar flux 
+         zdqns_ice_b(1:npti) = dqns_ice_1d(1:npti)                      ! derivative of incoming nonsolar flux
          zqns_ice_b (1:npti) = qns_ice_1d(1:npti)                       ! store previous qns_ice_1d value
          !
@@ -221 +221 @@
       !
       zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * za_s_fra(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - za_s_fra(1:npti) )
-      DO jk = 1, nlay_i 
+      DO jk = 1, nlay_i
          DO ji = 1, npti
             !                             ! radiation transmitted below the layer-th ice layer
@@ -227 +227 @@
                &                                       * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zh_min  ) ) &
                &            + ( 1._wp - za_s_fra(ji) ) * qtr_ice_top_1d(ji)                        &   ! part snow free
-               &                                       * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zhi_ssl ) )            
+               &                                       * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zhi_ssl ) )
             !                             ! radiation absorbed by the layer-th ice layer
             zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk)
@@ -288 +288 @@
          DO ji = 1, npti
             IF ( .NOT. l_T_converged(ji) ) &
-               ztcond_i(ji,:) = MAX( zkimin, ztcond_i_cp(ji,:) )        
+               ztcond_i(ji,:) = MAX( zkimin, ztcond_i_cp(ji,:) )
          END DO
          !
@@ -401 +401 @@
             zdiagbis(1:npti,:)   = 0._wp
 
-            DO jm = nlay_s + 2, nlay_s + nlay_i 
+            DO jm = nlay_s + 2, nlay_s + nlay_i
                DO ji = 1, npti
                   jk = jm - nlay_s - 1
@@ -414 +414 @@
             DO ji = 1, npti
                ! ice bottom term
-               ztrid   (ji,jm,1) =       - zeta_i(ji,nlay_i) *   zkappa_i(ji,nlay_i-1)   
+               ztrid   (ji,jm,1) =       - zeta_i(ji,nlay_i) *   zkappa_i(ji,nlay_i-1)
                ztrid   (ji,jm,2) = 1._wp + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i-1) + zkappa_i(ji,nlay_i) * zg1 )
                ztrid   (ji,jm,3) = 0._wp
                zindterm(ji,jm)   = ztiold(ji,nlay_i) + zeta_i(ji,nlay_i) *  &
-                  &              ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) ) 
+                  &              ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) )
             END DO
 
@@ -433 +433 @@
                      zindterm(ji,jm)   = ztsold(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk)
                   END DO
-                  
+
                   ! case of only one layer in the ice (ice equation is altered)
                   IF( nlay_i == 1 ) THEN
                      ztrid   (ji,nlay_s+2,3) = 0._wp
-                     zindterm(ji,nlay_s+2)   = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji) 
-                  ENDIF
-                  
+                     zindterm(ji,nlay_s+2)   = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji)
+                  ENDIF
+
                   IF( t_su_1d(ji) < rt0 ) THEN   !--  case 1 : no surface melting
-                     
+
                      jm_min(ji) = 1
                      jm_max(ji) = nlay_i + nlay_s + 1
-                     
+
                      ! surface equation
                      ztrid   (ji,1,1) = 0._wp
@@ -450 +450 @@
                      ztrid   (ji,1,3) =                   zg1s * zkappa_s(ji,0)
                      zindterm(ji,1)   = zdqns_ice_b(ji) * t_su_1d(ji) - zfnet(ji)
-                     
+
                      ! first layer of snow equation
                      ztrid   (ji,2,1) =       - zeta_s(ji,1) *                    zkappa_s(ji,0) * zg1s
@@ -456 +456 @@
                      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)
-                     
+
                   ELSE                            !--  case 2 : surface is melting
                      !
                      jm_min(ji) = 2
                      jm_max(ji) = nlay_i + nlay_s + 1
-                     
+
                      ! first layer of snow equation
                      ztrid   (ji,2,1) = 0._wp
                      ztrid   (ji,2,2) = 1._wp + 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) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 
+                     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) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) )
                   ENDIF
                   !                            !---------------------!
@@ -476 +476 @@
                      jm_min(ji) = nlay_s + 1
                      jm_max(ji) = nlay_i + nlay_s + 1
-                     
-                     ! surface equation   
+
+                     ! surface equation
                      ztrid   (ji,jm_min(ji),1) = 0._wp
-                     ztrid   (ji,jm_min(ji),2) = zdqns_ice_b(ji) - zkappa_i(ji,0) * zg1    
+                     ztrid   (ji,jm_min(ji),2) = zdqns_ice_b(ji) - zkappa_i(ji,0) * zg1
                      ztrid   (ji,jm_min(ji),3) =                   zkappa_i(ji,0) * zg1
                      zindterm(ji,jm_min(ji))   = zdqns_ice_b(ji) * t_su_1d(ji) - zfnet(ji)
-                     
+
                      ! first layer of ice equation
                      ztrid   (ji,jm_min(ji)+1,1) =       - zeta_i(ji,1) *                    zkappa_i(ji,0) * zg1
                      ztrid   (ji,jm_min(ji)+1,2) = 1._wp + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )
-                     ztrid   (ji,jm_min(ji)+1,3) =       - zeta_i(ji,1) *   zkappa_i(ji,1)  
-                     zindterm(ji,jm_min(ji)+1)   = ztiold(ji,1) + zeta_i(ji,1) * zradab_i(ji,1)  
-                     
+                     ztrid   (ji,jm_min(ji)+1,3) =       - zeta_i(ji,1) *   zkappa_i(ji,1)
+                     zindterm(ji,jm_min(ji)+1)   = ztiold(ji,1) + zeta_i(ji,1) * zradab_i(ji,1)
+
                      ! case of only one layer in the ice (surface & ice equations are altered)
                      IF( nlay_i == 1 ) THEN
@@ -499 +499 @@
                         zindterm(ji,jm_min(ji)+1)   = ztiold(ji,1) + zeta_i(ji,1) * (zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji))
                      ENDIF
-                     
+
                   ELSE                            !--  case 2 : surface is melting
-                     
+
                      jm_min(ji) = nlay_s + 2
                      jm_max(ji) = nlay_i + nlay_s + 1
-                     
+
                      ! first layer of ice equation
                      ztrid   (ji,jm_min(ji),1) = 0._wp
-                     ztrid   (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )  
+                     ztrid   (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )
                      ztrid   (ji,jm_min(ji),3) =       - zeta_i(ji,1) *   zkappa_i(ji,1)
-                     zindterm(ji,jm_min(ji))   = ztiold(ji,1) + zeta_i(ji,1) * (zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji)) 
-                     
+                     zindterm(ji,jm_min(ji))   = ztiold(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)
                      IF( nlay_i == 1 ) THEN
@@ -519 +519 @@
                            &                      + t_su_1d(ji) * zeta_i(ji,1) * zkappa_i(ji,0) * 2._wp
                      ENDIF
-                     
+
                   ENDIF
                ENDIF
@@ -540 +540 @@
 !!$            END DO
 !!$            !!clem SNWLAY => check why LIM1D does not get this loop. Is nlay_i+5 correct?
-!!$            
+!!$
 !!$            DO jk = jm_mint+1, jm_maxt
 !!$               DO ji = 1, npti
@@ -574 +574 @@
             END DO
 
-            ! snow temperatures      
+            ! snow temperatures
             DO ji = 1, npti
                ! Variables used after iterations
@@ -589 +589 @@
                END DO
             END DO
-            
+
             ! surface temperature
             DO ji = 1, npti
@@ -628 +628 @@
                      zdti_max      =  MAX( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) )
                   END DO
-                  
+
                   ! convergence test
                   IF( ln_zdf_chkcvg ) THEN
@@ -665 +665 @@
             zdiagbis(1:npti,:)   = 0._wp
 
-            DO jm = nlay_s + 2, nlay_s + nlay_i 
+            DO jm = nlay_s + 2, nlay_s + nlay_i
                DO ji = 1, npti
                   jk = jm - nlay_s - 1
@@ -678 +678 @@
             DO ji = 1, npti
                ! ice bottom term
-               ztrid   (ji,jm,1) =       - zeta_i(ji,nlay_i) *   zkappa_i(ji,nlay_i-1)   
+               ztrid   (ji,jm,1) =       - zeta_i(ji,nlay_i) *   zkappa_i(ji,nlay_i-1)
                ztrid   (ji,jm,2) = 1._wp + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i-1) + zkappa_i(ji,nlay_i) * zg1 )
                ztrid   (ji,jm,3) = 0._wp
                zindterm(ji,jm)   = ztiold(ji,nlay_i) + zeta_i(ji,nlay_i) *  &
-                  &              ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) ) 
+                  &              ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) )
             ENDDO
 
@@ -697 +697 @@
                      zindterm(ji,jm)   = ztsold(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk)
                   END DO
-                  
+
                   ! case of only one layer in the ice (ice equation is altered)
                   IF ( nlay_i == 1 ) THEN
                      ztrid   (ji,nlay_s+2,3) = 0._wp
-                     zindterm(ji,nlay_s+2)   = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji) 
-                  ENDIF
-                  
+                     zindterm(ji,nlay_s+2)   = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji)
+                  ENDIF
+
                   jm_min(ji) = 2
                   jm_max(ji) = nlay_i + nlay_s + 1
-                  
+
                   ! first layer of snow equation
                   ztrid   (ji,2,1) = 0._wp
                   ztrid   (ji,2,2) = 1._wp + zeta_s(ji,1) * zkappa_s(ji,1)
-                  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) + qcn_ice_1d(ji) ) 
-                  
+                  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) + qcn_ice_1d(ji) )
+
                   !                            !---------------------!
                ELSE                            ! cells without snow  !
@@ -718 +718 @@
                   jm_min(ji) = nlay_s + 2
                   jm_max(ji) = nlay_i + nlay_s + 1
-                  
+
                   ! first layer of ice equation
                   ztrid   (ji,jm_min(ji),1) = 0._wp
-                  ztrid   (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * zkappa_i(ji,1)  
+                  ztrid   (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * zkappa_i(ji,1)
                   ztrid   (ji,jm_min(ji),3) =       - zeta_i(ji,1) * zkappa_i(ji,1)
                   zindterm(ji,jm_min(ji))   = ztiold(ji,1) + zeta_i(ji,1) * ( zradab_i(ji,1) + qcn_ice_1d(ji) )
-                  
+
                   ! case of only one layer in the ice (surface & ice equations are altered)
                   IF( nlay_i == 1 ) THEN
@@ -733 +733 @@
                         &                                     ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) + qcn_ice_1d(ji) )
                   ENDIF
-                  
+
                ENDIF
                !
@@ -752 +752 @@
 !!$               jm_maxt = MAX(jm_max(ji),jm_maxt)
 !!$            END DO
-!!$            
+!!$
 !!$            DO jk = jm_mint+1, jm_maxt
 !!$               DO ji = 1, npti
@@ -786 +786 @@
                END DO
             END DO
-            
-            ! snow temperatures      
+
+            ! snow temperatures
             DO ji = 1, npti
                ! Variables used after iterations
@@ -823 +823 @@
 
                   DO jk = 1, nlay_i
-                     ztmelts       = -rTmlt * sz_i_1d(ji,jk) + rt0 
+                     ztmelts       = -rTmlt * sz_i_1d(ji,jk) + rt0
                      t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelts ), rt0 - 100._wp )
                      zdti_max      =  MAX ( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) )
@@ -885 +885 @@
          !
          DO ji = 1, npti
-            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji) - zqns_ice_b(ji) ) * a_i_1d(ji) 
+            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji) - zqns_ice_b(ji) ) * a_i_1d(ji)
          END DO
          !
@@ -893 +893 @@
       !
       IF( k_cnd == np_cnd_OFF .OR. k_cnd == np_cnd_ON ) THEN
-         
-         CALL ice_var_enthalpy       
-         
+
+         CALL ice_var_enthalpy
+
          ! zhfx_err = correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation
          DO ji = 1, npti
             zdq = - zq_ini(ji) + ( SUM( e_i_1d(ji,1:nlay_i) ) * h_i_1d(ji) * r1_nlay_i +  &
                &                   SUM( e_s_1d(ji,1:nlay_s) ) * h_s_1d(ji) * r1_nlay_s )
-            
+
             IF( k_cnd == np_cnd_OFF ) THEN
-               
+
                IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC
                   zhfx_err = ( qns_ice_1d(ji)     + qsr_ice_1d(ji)     - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  &
@@ -910 +910 @@
                      &       + zdq * r1_Dt_ice ) * a_i_1d(ji)
                ENDIF
-               
+
             ELSEIF( k_cnd == np_cnd_ON ) THEN
-            
+
                zhfx_err    = ( qcn_ice_top_1d(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  &
                   &          + zdq * r1_Dt_ice ) * a_i_1d(ji)
-            
+
             ENDIF
             !
@@ -921 +921 @@
             hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err
             !
-            ! hfx_dif = Heat flux diagnostic of sensible heat used to warm/cool ice in W.m-2   
+            ! hfx_dif = Heat flux diagnostic of sensible heat used to warm/cool ice in W.m-2
             hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_Dt_ice * a_i_1d(ji)
             !
@@ -952 +952 @@
       ! --- SIMIP diagnostics
       !
-      DO ji = 1, npti         
+      DO ji = 1, npti
          !--- Snow-ice interfacial temperature (diagnostic SIMIP)
          IF( h_s_1d(ji) >= zhs_ssl ) THEN

NEMO/trunk/src/ICE/iceupdate.F90

@@ -67 +67 @@
       !!-------------------------------------------------------------------
       !!                ***  ROUTINE ice_update_flx ***
-      !!  
-      !! ** Purpose :   Update the surface ocean boundary condition for heat 
+      !!
+      !! ** Purpose :   Update the surface ocean boundary condition for heat
       !!                salt and mass over areas where sea-ice is non-zero
-      !!         
+      !!
       !! ** Action  : - computes the heat and freshwater/salt fluxes
       !!                at the ice-ocean interface.
       !!              - Update the ocean sbc
-      !!     
-      !! ** Outputs : - qsr     : sea heat flux:     solar 
+      !!
+      !! ** Outputs : - qsr     : sea heat flux:     solar
       !!              - qns     : sea heat flux: non solar
-      !!              - emp     : freshwater budget: volume flux 
-      !!              - sfx     : salt flux 
+      !!              - emp     : freshwater budget: volume flux
+      !!              - sfx     : salt flux
       !!              - fr_i    : ice fraction
       !!              - tn_ice  : sea-ice surface temperature
@@ -104 +104 @@
       ! Net heat flux on top of the ice-ocean (W.m-2)
       !----------------------------------------------
-      qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:) 
+      qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:)
 
       ! --- case we bypass ice thermodynamics --- !
@@ -114 +114 @@
          qevap_ice  (:,:,:) = 0._wp
       ENDIF
-      
+
       DO_2D( 1, 1, 1, 1 )
 
-         ! Solar heat flux reaching the ocean (max) = zqsr (W.m-2) 
+         ! Solar heat flux reaching the ocean (max) = zqsr (W.m-2)
          !---------------------------------------------------
          zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) )
 
-         ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 
+         ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2)
          !---------------------------------------------------
          qt_oce_ai(ji,jj) = qt_atm_oi(ji,jj) - hfx_sum(ji,jj) - hfx_bom(ji,jj) - hfx_bog(ji,jj) &
             &                                - hfx_dif(ji,jj) - hfx_opw(ji,jj) - hfx_snw(ji,jj) &
             &                                + hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) &
-            &                                + hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) + hfx_spr(ji,jj)                 
-         
+            &                                + hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) + hfx_spr(ji,jj)
+
          ! New qsr and qns used to compute the oceanic heat flux at the next time step
          !----------------------------------------------------------------------------
@@ -144 +144 @@
          !
          ! the non-solar is simply derived from the solar flux
-         qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr              
-         
-         ! Mass flux at the atm. surface       
+         qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr
+
+         ! Mass flux at the atm. surface
          !-----------------------------------
          wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj)
 
-         ! Mass flux at the ocean surface      
+         ! Mass flux at the ocean surface
          !------------------------------------
          ! ice-ocean  mass flux
          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_lam(ji,jj)
-         
+
          ! snw-ocean mass flux
          wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj)
-         
+
          ! total mass flux at the ocean/ice interface
          fmmflx(ji,jj) =                - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_pnd(ji,jj) - wfx_err_sub(ji,jj)   ! ice-ocean mass flux saved at least for biogeochemical model
          emp   (ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_pnd(ji,jj) - wfx_err_sub(ji,jj)   ! atm-ocean + ice-ocean mass flux
 
-         ! Salt flux at the ocean surface      
+         ! Salt flux at the ocean surface
          !------------------------------------------
          sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj)   &
             &       + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj)
-         
-         ! Mass of snow and ice per unit area   
+
+         ! Mass of snow and ice per unit area
          !----------------------------------------
          snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step
          !                                               ! new mass per unit area
-         snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) ) 
+         snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) )
          !                                               ! time evolution of snow+ice mass
          snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_Dt_ice
-         
+
       END_2D
 
       ! Storing the transmitted variables
       !----------------------------------
-      fr_i  (:,:)   = at_i(:,:)             ! Sea-ice fraction            
-      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                      
+      fr_i  (:,:)   = at_i(:,:)             ! Sea-ice fraction
+      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature
 
       ! Snow/ice albedo (only if sent to coupler, useless in forced mode)
@@ -216 +216 @@
       CALL iom_put( 'vfxice'    , wfx_ice     )   ! mass flux from total ice growth/melt
       CALL iom_put( 'vfxbog'    , wfx_bog     )   ! mass flux from bottom growth
-      CALL iom_put( 'vfxbom'    , wfx_bom     )   ! mass flux from bottom melt 
-      CALL iom_put( 'vfxsum'    , wfx_sum     )   ! mass flux from surface melt 
-      CALL iom_put( 'vfxlam'    , wfx_lam     )   ! mass flux from lateral melt 
+      CALL iom_put( 'vfxbom'    , wfx_bom     )   ! mass flux from bottom melt
+      CALL iom_put( 'vfxsum'    , wfx_sum     )   ! mass flux from surface melt
+      CALL iom_put( 'vfxlam'    , wfx_lam     )   ! mass flux from lateral melt
       CALL iom_put( 'vfxsni'    , wfx_sni     )   ! mass flux from snow-ice formation
       CALL iom_put( 'vfxopw'    , wfx_opw     )   ! mass flux from growth in open water
       CALL iom_put( 'vfxdyn'    , wfx_dyn     )   ! mass flux from dynamics (ridging)
-      CALL iom_put( 'vfxres'    , wfx_res     )   ! mass flux from undiagnosed processes 
+      CALL iom_put( 'vfxres'    , wfx_res     )   ! mass flux from undiagnosed processes
       CALL iom_put( 'vfxpnd'    , wfx_pnd     )   ! mass flux from melt ponds
       CALL iom_put( 'vfxsub'    , wfx_ice_sub )   ! mass flux from ice sublimation (ice-atm.)
-      CALL iom_put( 'vfxsub_err', wfx_err_sub )   ! "excess" of sublimation sent to ocean      
-
-      IF ( iom_use( 'vfxthin' ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations  
+      CALL iom_put( 'vfxsub_err', wfx_err_sub )   ! "excess" of sublimation sent to ocean
+
+      IF ( iom_use( 'vfxthin' ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations
          WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog
          ELSEWHERE                                     ; z2d = 0._wp
@@ -237 +237 @@
       CALL iom_put( 'vfxsnw'     , wfx_snw     )   ! mass flux from total snow growth/melt
       CALL iom_put( 'vfxsnw_sum' , wfx_snw_sum )   ! mass flux from snow melt at the surface
-      CALL iom_put( 'vfxsnw_sni' , wfx_snw_sni )   ! mass flux from snow melt during snow-ice formation 
-      CALL iom_put( 'vfxsnw_dyn' , wfx_snw_dyn )   ! mass flux from dynamics (ridging) 
-      CALL iom_put( 'vfxsnw_sub' , wfx_snw_sub )   ! mass flux from snow sublimation (ice-atm.) 
+      CALL iom_put( 'vfxsnw_sni' , wfx_snw_sni )   ! mass flux from snow melt during snow-ice formation
+      CALL iom_put( 'vfxsnw_dyn' , wfx_snw_dyn )   ! mass flux from dynamics (ridging)
+      CALL iom_put( 'vfxsnw_sub' , wfx_snw_sub )   ! mass flux from snow sublimation (ice-atm.)
       CALL iom_put( 'vfxsnw_pre' , wfx_spr     )   ! snow precip
 
@@ -252 +252 @@
       IF( iom_use('qt_oce'     ) )   CALL iom_put( 'qt_oce'     ,      ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce )
       IF( iom_use('qt_ice'     ) )   CALL iom_put( 'qt_ice'     , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 )     + qemp_ice )
-      IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( 'qt_oce_ai'  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm) 
-      IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( 'qt_atm_oi'  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce) 
+      IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( 'qt_oce_ai'  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm)
+      IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( 'qt_atm_oi'  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce)
       IF( iom_use('qemp_oce'   ) )   CALL iom_put( 'qemp_oce'   , qemp_oce                                                   )   ! Downward Heat Flux from E-P over ocean
       IF( iom_use('qemp_ice'   ) )   CALL iom_put( 'qemp_ice'   , qemp_ice                                                   )   ! Downward Heat Flux from E-P over ice
@@ -259 +259 @@
       ! heat fluxes from ice transformations
       !                            ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr )
-      CALL iom_put ('hfxbog'     , hfx_bog     )   ! heat flux used for ice bottom growth 
+      CALL iom_put ('hfxbog'     , hfx_bog     )   ! heat flux used for ice bottom growth
       CALL iom_put ('hfxbom'     , hfx_bom     )   ! heat flux used for ice bottom melt
       CALL iom_put ('hfxsum'     , hfx_sum     )   ! heat flux used for ice surface melt
       CALL iom_put ('hfxopw'     , hfx_opw     )   ! heat flux used for ice formation in open water
       CALL iom_put ('hfxdif'     , hfx_dif     )   ! heat flux used for ice temperature change
-      CALL iom_put ('hfxsnw'     , hfx_snw     )   ! heat flux used for snow melt 
+      CALL iom_put ('hfxsnw'     , hfx_snw     )   ! heat flux used for snow melt
       CALL iom_put ('hfxerr'     , hfx_err_dif )   ! heat flux error after heat diffusion
 
       ! heat fluxes associated with mass exchange (freeze/melt/precip...)
-      CALL iom_put ('hfxthd'     , hfx_thd     )   !  
-      CALL iom_put ('hfxdyn'     , hfx_dyn     )   !  
-      CALL iom_put ('hfxres'     , hfx_res     )   !  
-      CALL iom_put ('hfxsub'     , hfx_sub     )   !  
-      CALL iom_put ('hfxspr'     , hfx_spr     )   ! Heat flux from snow precip heat content 
+      CALL iom_put ('hfxthd'     , hfx_thd     )   !
+      CALL iom_put ('hfxdyn'     , hfx_dyn     )   !
+      CALL iom_put ('hfxres'     , hfx_res     )   !
+      CALL iom_put ('hfxsub'     , hfx_sub     )   !
+      CALL iom_put ('hfxspr'     , hfx_spr     )   ! Heat flux from snow precip heat content
 
       ! other heat fluxes
@@ -294 +294 @@
       !!-------------------------------------------------------------------
       !!                ***  ROUTINE ice_update_tau ***
-      !!  
+      !!
       !! ** Purpose : Update the ocean surface stresses due to the ice
-      !!         
+      !!
       !! ** Action  : * at each ice time step (every nn_fsbc time step):
-      !!                - compute the modulus of ice-ocean relative velocity 
+      !!                - compute the modulus of ice-ocean relative velocity
       !!                  (*rho*Cd) at T-point (C-grid) or I-point (B-grid)
       !!                      tmod_io = rhoco * | U_ice-U_oce |
       !!                - update the modulus of stress at ocean surface
       !!                      taum = (1-a) * taum + a * tmod_io * | U_ice-U_oce |
-      !!              * at each ocean time step (every kt): 
+      !!              * at each ocean time step (every kt):
       !!                  compute linearized ice-ocean stresses as
       !!                      Utau = tmod_io * | U_ice - pU_oce |
@@ -310 +310 @@
       !!    NB: - ice-ocean rotation angle no more allowed
       !!        - here we make an approximation: taum is only computed every ice time step
-      !!          This avoids mutiple average to pass from T -> U,V grids and next from U,V grids 
+      !!          This avoids mutiple average to pass from T -> U,V grids and next from U,V grids
       !!          to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton...
       !!
@@ -337 +337 @@
          DO_2D( 0, 0, 0, 0 )                          !* update the modulus of stress at ocean surface (T-point)
             !                                               ! 2*(U_ice-U_oce) at T-point
-            zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   
-            zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 
+            zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)
+            zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1)
             !                                              ! |U_ice-U_oce|^2
             zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )
@@ -354 +354 @@
       !                                      !==  every ocean time-step  ==!
       IF ( ln_drgice_imp ) THEN
-         ! Save drag with right sign to update top drag in the ocean implicit friction 
-         rCdU_ice(:,:) = -r1_rho0 * tmod_io(:,:) * at_i(:,:) * tmask(:,:,1) 
+         ! Save drag with right sign to update top drag in the ocean implicit friction
+         rCdU_ice(:,:) = -r1_rho0 * tmod_io(:,:) * at_i(:,:) * tmask(:,:,1)
          zflagi = 0._wp
       ELSE
@@ -362 +362 @@
       !
       DO_2D( 0, 0, 0, 0 )                             !* update the stress WITHOUT an ice-ocean rotation angle
-         ! ice area at u and v-points 
+         ! ice area at u and v-points
          zat_u  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj    ) * tmask(ji+1,jj  ,1) )  &
             &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj  ,1) )
@@ -377 +377 @@
       !
       IF( ln_timing )   CALL timing_stop('ice_update')
-      !  
+      !
    END SUBROUTINE ice_update_tau
 
@@ -384 +384 @@
       !!-------------------------------------------------------------------
       !!                  ***  ROUTINE ice_update_init  ***
-      !!             
+      !!
       !! ** Purpose :   allocate ice-ocean stress fields and read restarts
       !!                containing the snow & ice mass
@@ -408 +408 @@
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE rhg_evp_rst  ***
-      !!                     
+      !!
       !! ** Purpose :   Read or write RHG file in restart file
       !!
@@ -456 +456 @@
    !!   Default option         Dummy module           NO SI3 sea-ice model
    !!----------------------------------------------------------------------
-#endif 
+#endif
 
    !!======================================================================

NEMO/trunk/src/ICE/icevar.F90

@@ -34 +34 @@
    !!                        - st_i(jpi,jpj)
    !!                        - et_s(jpi,jpj)  total snow heat content
-   !!                        - et_i(jpi,jpj)  total ice thermal content 
+   !!                        - et_i(jpi,jpj)  total ice thermal content
    !!                        - sm_i(jpi,jpj)  mean ice salinity
    !!                        - tm_i(jpi,jpj)  mean ice temperature
@@ -55 +55 @@
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean space and time domain
-   USE phycst         ! physical constants (ocean directory) 
+   USE phycst         ! physical constants (ocean directory)
    USE sbc_oce , ONLY : sss_m, ln_ice_embd, nn_fsbc
    USE ice            ! sea-ice: variables
@@ -67 +67 @@
    PRIVATE
 
-   PUBLIC   ice_var_agg          
-   PUBLIC   ice_var_glo2eqv      
-   PUBLIC   ice_var_eqv2glo      
-   PUBLIC   ice_var_salprof      
-   PUBLIC   ice_var_salprof1d    
+   PUBLIC   ice_var_agg
+   PUBLIC   ice_var_glo2eqv
+   PUBLIC   ice_var_eqv2glo
+   PUBLIC   ice_var_salprof
+   PUBLIC   ice_var_salprof1d
    PUBLIC   ice_var_zapsmall
    PUBLIC   ice_var_zapneg
    PUBLIC   ice_var_roundoff
-   PUBLIC   ice_var_bv           
-   PUBLIC   ice_var_enthalpy           
+   PUBLIC   ice_var_bv
+   PUBLIC   ice_var_enthalpy
    PUBLIC   ice_var_sshdyn
    PUBLIC   ice_var_itd
@@ -108 +108 @@
       !!                ***  ROUTINE ice_var_agg  ***
       !!
-      !! ** Purpose :   aggregates ice-thickness-category variables to 
+      !! ** Purpose :   aggregates ice-thickness-category variables to
       !!              all-ice variables, i.e. it turns VGLO into VAGG
       !!-------------------------------------------------------------------
@@ -130 +130 @@
       vt_il(:,:) = SUM( v_il(:,:,:), dim=3 )
       !
-      ato_i(:,:) = 1._wp - at_i(:,:)         ! open water fraction  
+      ato_i(:,:) = 1._wp - at_i(:,:)         ! open water fraction
       !
       !!GS: tm_su always needed by ABL over sea-ice
@@ -155 +155 @@
          hm_i(:,:) = vt_i(:,:) * z1_at_i(:,:)
          hm_s(:,:) = vt_s(:,:) * z1_at_i(:,:)
-         !         
+         !
          !                          ! mean temperature (K), salinity and age
          tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:)
@@ -182 +182 @@
          WHERE( at_ip(:,:) > epsi20 )   ;   hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:)   ;   hm_il(:,:) = vt_il(:,:) / at_ip(:,:)
          ELSEWHERE                      ;   hm_ip(:,:) = 0._wp                     ;   hm_il(:,:) = 0._wp
-         END WHERE         
+         END WHERE
          !
          DEALLOCATE( z1_vt_i , z1_vt_s )
@@ -197 +197 @@
       !!                ***  ROUTINE ice_var_glo2eqv ***
       !!
-      !! ** Purpose :   computes equivalent variables as function of  
+      !! ** Purpose :   computes equivalent variables as function of
       !!              global variables, i.e. it turns VGLO into VEQV
       !!-------------------------------------------------------------------
@@ -210 +210 @@
       !!-------------------------------------------------------------------
 
-!!gm Question 2:  It is possible to define existence of sea-ice in a common way between 
+!!gm Question 2:  It is possible to define existence of sea-ice in a common way between
 !!                ice area and ice volume ?
 !!                the idea is to be able to define one for all at the begining of this routine
@@ -234 +234 @@
 
       zhmax    =          hi_max(jpl)
-      z1_zhmax =  1._wp / hi_max(jpl)               
+      z1_zhmax =  1._wp / hi_max(jpl)
       WHERE( h_i(:,:,jpl) > zhmax )   ! bound h_i by hi_max (i.e. 99 m) with associated update of ice area
          h_i   (:,:,jpl) = zhmax
-         a_i   (:,:,jpl) = v_i(:,:,jpl) * z1_zhmax 
+         a_i   (:,:,jpl) = v_i(:,:,jpl) * z1_zhmax
          z1_a_i(:,:,jpl) = zhmax * z1_v_i(:,:,jpl)
       END WHERE
       !                                           !--- snow thickness
       h_s(:,:,:) = v_s (:,:,:) * z1_a_i(:,:,:)
-      !                                           !--- ice age      
+      !                                           !--- ice age
       o_i(:,:,:) = oa_i(:,:,:) * z1_a_i(:,:,:)
-      !                                           !--- pond and lid thickness      
+      !                                           !--- pond and lid thickness
       h_ip(:,:,:) = v_ip(:,:,:) * z1_a_ip(:,:,:)
       h_il(:,:,:) = v_il(:,:,:) * z1_a_ip(:,:,:)
@@ -258 +258 @@
       a_ip_eff = MIN( a_ip_eff, 1._wp - za_s_fra )   ! make sure (a_ip_eff + a_s_fra) <= 1
       !
-      !                                           !---  salinity (with a minimum value imposed everywhere)     
+      !                                           !---  salinity (with a minimum value imposed everywhere)
       IF( nn_icesal == 2 ) THEN
          WHERE( v_i(:,:,:) > epsi20 )   ;   s_i(:,:,:) = MAX( rn_simin , MIN( rn_simax, sv_i(:,:,:) * z1_v_i(:,:,:) ) )
@@ -272 +272 @@
       DO jl = 1, jpl
          DO_3D( 1, 1, 1, 1, 1, nlay_i )
-            IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area 
+            IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area
                !
                ze_i             =   e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i             ! Energy of melting e(S,T) [J.m-3]
@@ -300 +300 @@
       END DO
       !
-      ! integrated values 
+      ! integrated values
       vt_i (:,:) = SUM( v_i , dim=3 )
       vt_s (:,:) = SUM( v_s , dim=3 )
@@ -312 +312 @@
       !!                ***  ROUTINE ice_var_eqv2glo ***
       !!
-      !! ** Purpose :   computes global variables as function of 
+      !! ** Purpose :   computes global variables as function of
       !!              equivalent variables,  i.e. it turns VEQV into VGLO
       !!-------------------------------------------------------------------
@@ -329 +329 @@
       !!                ***  ROUTINE ice_var_salprof ***
       !!
-      !! ** Purpose :   computes salinity profile in function of bulk salinity     
-      !!
-      !! ** Method  : If bulk salinity greater than zsi1, 
+      !! ** Purpose :   computes salinity profile in function of bulk salinity
+      !!
+      !! ** Method  : If bulk salinity greater than zsi1,
       !!              the profile is assumed to be constant (S_inf)
       !!              If bulk salinity lower than zsi0,
@@ -348 +348 @@
       !!-------------------------------------------------------------------
 
-!!gm Question: Remove the option 3 ?  How many years since it last use ? 
+!!gm Question: Remove the option 3 ?  How many years since it last use ?
 
       SELECT CASE ( nn_icesal )
@@ -369 +369 @@
             END DO
          END DO
-         !                                      ! Slope of the linear profile 
+         !                                      ! Slope of the linear profile
          WHERE( h_i(:,:,:) > epsi20 )   ;   z_slope_s(:,:,:) = 2._wp * s_i(:,:,:) / h_i(:,:,:)
          ELSEWHERE                      ;   z_slope_s(:,:,:) = 0._wp
@@ -379 +379 @@
                zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  )
                !                             ! force a constant profile when SSS too low (Baltic Sea)
-               IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp  
+               IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp
             END_2D
          END DO
@@ -448 +448 @@
          ALLOCATE( z_slope_s(jpij), zalpha(jpij) )
          !
-         !                                      ! Slope of the linear profile 
+         !                                      ! Slope of the linear profile
          WHERE( h_i_1d(1:npti) > epsi20 )   ;   z_slope_s(1:npti) = 2._wp * s_i_1d(1:npti) / h_i_1d(1:npti)
          ELSEWHERE                          ;   z_slope_s(1:npti) = 0._wp
          END WHERE
-         
+
          z1_dS = 1._wp / ( zsi1 - zsi0 )
          DO ji = 1, npti
@@ -557 +557 @@
          END_2D
          !
-      END DO 
+      END DO
 
       ! to be sure that at_i is the sum of a_i(jl)
@@ -648 +648 @@
          END_2D
          !
-      END DO 
+      END DO
       !
       WHERE( pato_i(:,:)   < 0._wp )   pato_i(:,:)   = 0._wp
@@ -693 +693 @@
       !
    END SUBROUTINE ice_var_roundoff
-   
+
 
    SUBROUTINE ice_var_bv
@@ -713 +713 @@
       DO jl = 1, jpl
          DO jk = 1, nlay_i
-            WHERE( t_i(:,:,jk,jl) < rt0 - epsi10 )   
+            WHERE( t_i(:,:,jk,jl) < rt0 - epsi10 )
                bv_i(:,:,jl) = bv_i(:,:,jl) - rTmlt * sz_i(:,:,jk,jl) * r1_nlay_i / ( t_i(:,:,jk,jl) - rt0 )
             END WHERE
@@ -727 +727 @@
    SUBROUTINE ice_var_enthalpy
       !!-------------------------------------------------------------------
-      !!                   ***  ROUTINE ice_var_enthalpy *** 
-      !!                 
+      !!                   ***  ROUTINE ice_var_enthalpy ***
+      !!
       !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature
       !!
@@ -734 +734 @@
       !!-------------------------------------------------------------------
       INTEGER  ::   ji, jk   ! dummy loop indices
-      REAL(wp) ::   ztmelts  ! local scalar 
+      REAL(wp) ::   ztmelts  ! local scalar
       !!-------------------------------------------------------------------
       !
@@ -741 +741 @@
             ztmelts      = - rTmlt  * sz_i_1d(ji,jk)
             t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts + rt0 ) ! Force t_i_1d to be lower than melting point => likely conservation issue
-                                                                !   (sometimes zdf scheme produces abnormally high temperatures)   
+                                                                !   (sometimes zdf scheme produces abnormally high temperatures)
             e_i_1d(ji,jk) = rhoi * ( rcpi  * ( ztmelts - ( t_i_1d(ji,jk) - rt0 ) )           &
                &                   + rLfus * ( 1._wp - ztmelts / ( t_i_1d(ji,jk) - rt0 ) )   &
@@ -755 +755 @@
    END SUBROUTINE ice_var_enthalpy
 
-   
+
    FUNCTION ice_var_sshdyn(pssh, psnwice_mass, psnwice_mass_b)
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE ice_var_sshdyn  ***
-      !!                     
+      !!
       !! ** Purpose :  compute the equivalent ssh in lead when sea ice is embedded
       !!
@@ -765 +765 @@
       !!
       !! ** Reference : Jean-Michel Campin, John Marshall, David Ferreira,
-      !!                Sea ice-ocean coupling using a rescaled vertical coordinate z*, 
+      !!                Sea ice-ocean coupling using a rescaled vertical coordinate z*,
       !!                Ocean Modelling, Volume 24, Issues 1-2, 2008
       !!----------------------------------------------------------------------
@@ -783 +783 @@
       ! compute ice load used to define the equivalent ssh in lead
       IF( ln_ice_embd ) THEN
-         !                                            
+         !
          ! average interpolation coeff as used in dynspg = (1/nn_fsbc)   * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
          !                                               = (1/nn_fsbc)^2 * {SUM[n]        , n=0,nn_fsbc-1}
@@ -802 +802 @@
    END FUNCTION ice_var_sshdyn
 
-   
+
    !!-------------------------------------------------------------------
    !!                ***  INTERFACE ice_var_itd   ***
@@ -831 +831 @@
       ph_ip(:) = phtip(:)
       ph_il(:) = phtil(:)
-      
+
    END SUBROUTINE ice_var_itd_1c1c
 
@@ -846 +846 @@
       REAL(wp), ALLOCATABLE, DIMENSION(:) ::   z1_ai, z1_vi, z1_vs
       !
-      INTEGER ::   idim  
+      INTEGER ::   idim
       !!-------------------------------------------------------------------
       !
@@ -888 +888 @@
       !
    END SUBROUTINE ice_var_itd_Nc1c
-   
+
    SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,                             ph_i, ph_s, pa_i, &
       &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il )
@@ -898 +898 @@
       !! ** Method:   ice thickness distribution follows a gamma function from Abraham et al. (2015)
       !!              it has the property of conserving total concentration and volume
-      !!              
+      !!
       !!
       !! ** Arguments : phti: 1-cat ice thickness
@@ -904 +904 @@
       !!                pati: 1-cat ice concentration
       !!
-      !! ** Output    : jpl-cat 
+      !! ** Output    : jpl-cat
       !!
       !!  Abraham, C., Steiner, N., Monahan, A. and Michel, C., 2015.
       !!               Effects of subgrid‐scale snow thickness variability on radiative transfer in sea ice.
-      !!               Journal of Geophysical Research: Oceans, 120(8), pp.5597-5614 
+      !!               Journal of Geophysical Research: Oceans, 120(8), pp.5597-5614
       !!-------------------------------------------------------------------
       REAL(wp), DIMENSION(:),   INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables
@@ -987 +987 @@
                ! In case snow load is in excess that would lead to transformation from snow to ice
                ! Then, transfer the snow excess into the ice (different from icethd_dh)
-               zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rho0 ) * ph_i(ji,jl) ) * r1_rho0 ) 
+               zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rho0 ) * ph_i(ji,jl) ) * r1_rho0 )
                ! recompute h_i, h_s avoiding out of bounds values
                ph_i(ji,jl) = MIN( hi_max(jl), ph_i(ji,jl) + zdh )
@@ -1047 +1047 @@
       !!
       !! ** Method:   Iterative procedure
-      !!                
+      !!
       !!               1) Fill ice cat that correspond to input thicknesses
       !!                  Find the lowest(jlmin) and highest(jlmax) cat that are filled
       !!
       !!               2) Expand the filling to the cat jlmin-1 and jlmax+1
-      !!                   by removing 25% ice area from jlmin and jlmax (resp.) 
-      !!              
-      !!               3) Expand the filling to the empty cat between jlmin and jlmax 
+      !!                   by removing 25% ice area from jlmin and jlmax (resp.)
+      !!
+      !!               3) Expand the filling to the empty cat between jlmin and jlmax
       !!                   by a) removing 25% ice area from the lower cat (ascendant loop jlmin=>jlmax)
       !!                      b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin)
@@ -1062 +1062 @@
       !!                pati: N-cat ice concentration
       !!
-      !! ** Output    : jpl-cat 
-      !!
-      !!  (Example of application: BDY forcings when inputs have N-cat /= jpl)  
+      !! ** Output    : jpl-cat
+      !!
+      !!  (Example of application: BDY forcings when inputs have N-cat /= jpl)
       !!-------------------------------------------------------------------
       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables
@@ -1077 +1077 @@
       REAL(wp), PARAMETER ::   ztrans = 0.25_wp
       INTEGER  ::   ji, jl, jl1, jl2
-      INTEGER  ::   idim, icat  
+      INTEGER  ::   idim, icat
       !!-------------------------------------------------------------------
       !
@@ -1116 +1116 @@
       ELSE                              ! input cat /= output cat !
          !                              ! ----------------------- !
-         
+
          ALLOCATE( jlfil(idim,jpl), jlfil2(idim,jpl) )       ! allocate arrays
          ALLOCATE( jlmin(idim), jlmax(idim) )
@@ -1126 +1126 @@
          !
          ! --- fill the categories --- !
-         !     find where cat-input = cat-output and fill cat-output fields  
+         !     find where cat-input = cat-output and fill cat-output fields
          jlmax(:) = 0
          jlmin(:) = 999
@@ -1147 +1147 @@
          END DO
          !
-         ! --- fill the gaps between categories --- !  
+         ! --- fill the gaps between categories --- !
          !     transfer from categories filled at the previous step to the empty ones in between
          DO ji = 1, idim
@@ -1168 +1168 @@
          END DO
          !
-         jlfil2(:,:) = jlfil(:,:) 
+         jlfil2(:,:) = jlfil(:,:)
          ! fill categories from low to high
          DO jl = 2, jpl-1
@@ -1189 +1189 @@
                   ! fill low
                   pa_i(ji,jl) = pa_i(ji,jl) + ztrans * pa_i(ji,jl+1)
-                  ph_i(ji,jl) = hi_mean(jl) 
+                  ph_i(ji,jl) = hi_mean(jl)
                   jlfil2(ji,jl) = jl
                   ! remove high
@@ -1279 +1279 @@
    !!               we argue that snow does not cover the whole ice because
    !!               of wind blowing...
-   !!                
+   !!
    !! ** Arguments : ph_s: snow thickness
-   !!                
+   !!
    !! ** Output    : pa_s_fra: fraction of ice covered by snow
    !!
@@ -1326 +1326 @@
       ENDIF
    END SUBROUTINE ice_var_snwfra_1d
-   
+
    !!--------------------------------------------------------------------------
    !! INTERFACE ice_var_snwblow
@@ -1336 +1336 @@
    !!                If snow fall was uniform, a fraction (1-at_i) would fall into leads
    !!                but because of the winds, more snow falls on leads than on sea ice
-   !!                and a greater fraction (1-at_i)^beta of the total mass of snow 
+   !!                and a greater fraction (1-at_i)^beta of the total mass of snow
    !!                (beta < 1) falls in leads.
-   !!                In reality, beta depends on wind speed, 
-   !!                and should decrease with increasing wind speed but here, it is 
+   !!                In reality, beta depends on wind speed,
+   !!                and should decrease with increasing wind speed but here, it is
    !!                considered as a constant. an average value is 0.66
    !!--------------------------------------------------------------------------

NEMO/trunk/src/ICE/icewri.F90

@@ -10 +10 @@
    !!   'key_si3'                                       SI3 sea-ice model
    !!----------------------------------------------------------------------
-   !!   ice_wri       : write of the diagnostics variables in ouput file 
+   !!   ice_wri       : write of the diagnostics variables in ouput file
    !!   ice_wri_state : write for initial state or/and abandon
    !!----------------------------------------------------------------------
@@ -33 +33 @@
 
    PUBLIC ice_wri        ! called by ice_stp
-   PUBLIC ice_wri_state  ! called by dia_wri_state 
+   PUBLIC ice_wri_state  ! called by dia_wri_state
 
    !! * Substitutions
@@ -52 +52 @@
       INTEGER  ::   ji, jj, jk, jl  ! dummy loop indices
       REAL(wp) ::   z2da, z2db, zrho1, zrho2
-      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios 
+      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios
       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d, zfast                     ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj)     ::   zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask
@@ -59 +59 @@
       ! Global ice diagnostics (SIMIP)
       REAL(wp) ::   zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh   ! area, extent, volume
-      REAL(wp) ::   zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh 
+      REAL(wp) ::   zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh
       !!-------------------------------------------------------------------
       !
@@ -92 +92 @@
       CALL iom_put( 'icemask05', zmsk05 )   ! ice mask 5%
       CALL iom_put( 'icemask15', zmsk15 )   ! ice mask 15%
-      CALL iom_put( 'icepres'  , zmsk00 )   ! Ice presence (1 or 0) 
+      CALL iom_put( 'icepres'  , zmsk00 )   ! Ice presence (1 or 0)
       !
       ! general fields
-      IF( iom_use('icemass' ) )   CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 )                                           ! Ice mass per cell area 
+      IF( iom_use('icemass' ) )   CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 )                                           ! Ice mass per cell area
       IF( iom_use('snwmass' ) )   CALL iom_put( 'snwmass', vt_s * rhos * zmsksn )                                           ! Snow mass per cell area
       IF( iom_use('iceconc' ) )   CALL iom_put( 'iceconc', at_i        * zmsk00 )                                           ! ice concentration
@@ -106 +106 @@
       IF( iom_use('snwvolu' ) )   CALL iom_put( 'snwvolu', vt_s        * zmsksn )                                           ! snow volume
       IF( iom_use('icefrb'  ) ) THEN                                                                                        ! Ice freeboard
-         z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) )                                         
+         z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) )
          WHERE( z2d < 0._wp )   z2d = 0._wp
                                   CALL iom_put( 'icefrb' , z2d * zmsk00         )
@@ -186 +186 @@
       IF( iom_use('dmsmel') )   CALL iom_put( 'dmsmel', - wfx_snw_sum                                                         ) ! Snow mass change through melt
       IF( iom_use('dmsdyn') )   CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs                                    ) ! Snow mass change through dynamics(kg/m2/s)
-      
+
       ! Global ice diagnostics
       IF(  iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. &
@@ -221 +221 @@
    END SUBROUTINE ice_wri
 
- 
+
    SUBROUTINE ice_wri_state( kid )
       !!---------------------------------------------------------------------
       !!                 ***  ROUTINE ice_wri_state  ***
-      !!        
-      !! ** Purpose :   create a NetCDF file named cdfile_name which contains 
+      !!
+      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
       !!      the instantaneous ice state and forcing fields for ice model
       !!        Used to find errors in the initial state or save the last
@@ -233 +233 @@
       !! History :   4.0  !  2013-06  (C. Rousset)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kid 
+      INTEGER, INTENT( in ) ::   kid
       !!----------------------------------------------------------------------
       !