New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 921 – NEMO

Changeset 921


Ignore:
Timestamp:
2008-05-13T10:28:52+02:00 (16 years ago)
Author:
rblod
Message:

Correct indentation and print for debug in LIM3, see ticket #134, step I

Location:
trunk/NEMO
Files:
31 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/LIM_SRC_3/dom_ice.F90

    r834 r921  
    2424   INTEGER, PUBLIC ::   &  !: 
    2525      njeq , njeqm1        !: j-index of the equator if it is inside the domain 
    26       !                    !  (otherwise = jpj+10 (SH) or -10 (SH) ) 
     26   !                    !  (otherwise = jpj+10 (SH) or -10 (SH) ) 
    2727 
    2828   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 

  • trunk/NEMO/LIM_SRC_3/ice.F90

    r904 r921  
    217217      s_i_min  =  0.1 ,  &  !: minimum ice salinity (ppt) 
    218218      s_i_0    =  3.5 ,  &  !: 1st sal. value for the computation of sal .prof. 
    219                             !: (ppt) 
     219                                !: (ppt) 
    220220      s_i_1    =  4.5 ,  &  !: 2nd sal. value for the computation of sal .prof. 
    221                             !: (ppt) 
     221                                !: (ppt) 
    222222      sal_G    = 5.00 ,  &  !: restoring salinity for gravity drainage 
    223                             !: (ppt) 
     223                                !: (ppt) 
    224224      sal_F    = 2.50 ,  &  !: restoring salinity for flushing 
    225                             !: (ppt) 
     225                                !: (ppt) 
    226226      time_G   = 1.728e+06,&!: restoring time constant for gravity drainage 
    227                             !: (= 20 days, in s) 
     227                                !: (= 20 days, in s) 
    228228      time_F   = 8.640e+05,&!: restoring time constant for gravity drainage  
    229                             !: (= 10 days, in s) 
     229                                !: (= 10 days, in s) 
    230230      bulk_sal = 4.0        !: bulk salinity (ppt) in case of constant salinity 
    231231 
    232232   INTEGER , PUBLIC ::   & !!: ** ice-salinity namelist (namicesal) ** 
    233233      num_sal  = 1    ,  &  !: salinity configuration used in the model 
    234                             !: 1 - s constant in space and time 
    235                             !: 2 - prognostic salinity (s(z,t)) 
    236                             !: 3 - salinity profile, constant in time 
    237                             !: 4 - salinity variations affect only ice 
    238                             !      thermodynamics 
     234                                !: 1 - s constant in space and time 
     235                                !: 2 - prognostic salinity (s(z,t)) 
     236                                !: 3 - salinity profile, constant in time 
     237                                !: 4 - salinity variations affect only ice 
     238                                !      thermodynamics 
    239239      sal_prof = 1    ,  &  !: salinity profile or not  
    240240      thcon_i_swi = 1       !: thermal conductivity of Untersteiner (1964) (1) or 
    241                             !: Pringle et al (2007) (2) 
     241   !: Pringle et al (2007) (2) 
    242242 
    243243   REAL(wp), PUBLIC ::   & !!: ** ice-mechanical redistribution namelist (namiceitdme) 
    … …  
    249249      astar = 0.05    ,  & !!: equivalent of G* for an exponential participation function 
    250250      Hstar = 100.0   ,  & !!: thickness that determines the maximal thickness of ridged 
    251                            !!: ice 
     251                                !!: ice 
    252252      hparmeter = 0.75,  & !!: threshold thickness (m) for rafting / ridging  
    253253      Craft = 5.0     ,  & !!: coefficient for smoothness of the hyperbolic tangent in rafting 
    … …  
    256256      betas    = 1.0      , & !:: coef. for partitioning of snowfall between leads and sea ice 
    257257      kappa_i  = 1.0      , & !!: coefficient for the extinction of radiation 
    258                               !!: Grenfell et al. (2006) (m-1) 
     258                                !!: Grenfell et al. (2006) (m-1) 
    259259      nconv_i_thd = 50    , & !!: maximal number of iterations for heat diffusion 
    260260      maxer_i_thd = 1.0e-4    !!: maximal tolerated error (C) for heat diffusion 
    … …  
    264264      raftswi          = 1, & !!: rafting of ice or not                         
    265265      partfun_swi      = 1, & !!: participation function Thorndike et al. JGR75 (0)  
    266                               !!: or Lipscomb et al. JGR07 (1)  
     266                                !!: or Lipscomb et al. JGR07 (1)  
    267267      transfun_swi     = 0, & !!: transfer function of Hibler, MWR80 (0)  
    268                               !!: or Lipscomb et al., 2007 (1) 
     268                                !!: or Lipscomb et al., 2007 (1) 
    269269      brinstren_swi    = 0    !!: use brine volume to diminish ice strength 
    270270 
    … …  
    301301      t_bo   ,   &  !: Sea-Ice bottom temperature (Kelvin)       
    302302      hicifp ,   &  !: Ice production/melting 
    303       !obsolete... can be removed 
     303                                !obsolete... can be removed 
    304304      frld   ,   &  !: Leads fraction = 1-a/totalarea REFERS TO LEAD FRACTION everywhere 
    305                     !: except in the OUTPUTS!!!! 
     305                                !: except in the OUTPUTS!!!! 
    306306      pfrld  ,   &  !: Leads fraction at previous time   
    307307      phicif ,   &  !: Old ice thickness 
    … …  
    328328      fheat_res, &  !: Residual heat flux due to correction of ice thickness 
    329329      fhmec         !: Heat flux due to snow loss during compression 
    330        
     330 
    331331   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::       &  !: 
    332332      albege ,   &  !: Albedo of the snow or ice (only for outputs) 
    … …  
    334334      tauc          !: Cloud optical depth 
    335335 
    336 ! temporary arrays for dummy version of the code 
     336   ! temporary arrays for dummy version of the code 
    337337   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    338338      dh_i_surf2D, dh_i_bott2D, fstbif, fsup2D, focea2D, q_s 
    … …  
    354354      sm_i   ,   &  !: Sea-Ice Bulk salinity (ppt) 
    355355      smv_i  ,   &  !: Sea-Ice Bulk salinity times volume per area (ppt.m) 
    356                     !: this is an extensive variable that has to be transported 
     356                                !: this is an extensive variable that has to be transported 
    357357      o_i    ,   &  !: Sea-Ice Age (days) 
    358358      ov_i   ,   &  !: Sea-Ice Age times volume per area (days.m) 
    … …  
    401401   !!-------------------------------------------------------------------------- 
    402402   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   &  !: 
    403          sxopw, syopw, sxxopw, syyopw, sxyopw          !: open water in sea ice 
     403      sxopw, syopw, sxxopw, syyopw, sxyopw          !: open water in sea ice 
    404404 
    405405   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   &  !: 
    406          sxice, syice, sxxice, syyice, sxyice,      &  !: ice thickness moments for advection 
    407          sxsn,  sysn,  sxxsn,  syysn,  sxysn,       &  !: snow thickness 
    408          sxa,   sya,   sxxa,   syya,   sxya,        &  !: lead fraction 
    409          sxc0,  syc0,  sxxc0,  syyc0,  sxyc0,       &  !: snow thermal content 
    410          sxsal, sysal, sxxsal, syysal, sxysal,      &  !: ice salinity 
    411          sxage, syage, sxxage, syyage, sxyage          !: ice age 
     406      sxice, syice, sxxice, syyice, sxyice,      &  !: ice thickness moments for advection 
     407      sxsn,  sysn,  sxxsn,  syysn,  sxysn,       &  !: snow thickness 
     408      sxa,   sya,   sxxa,   syya,   sxya,        &  !: lead fraction 
     409      sxc0,  syc0,  sxxc0,  syyc0,  sxyc0,       &  !: snow thermal content 
     410      sxsal, sysal, sxxsal, syysal, sxysal,      &  !: ice salinity 
     411      sxage, syage, sxxage, syyage, sxyage          !: ice age 
    412412 
    413413   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jkmax,jpl) ::   &  !: 
    414          sxe ,  sye ,  sxxe ,  syye ,  sxye            !: ice layers heat content 
     414      sxe ,  sye ,  sxxe ,  syye ,  sxye            !: ice layers heat content 
    415415 
    416416   !!-------------------------------------------------------------------------- 
    … …  
    446446   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jkmax,jpl) ::   &  !: 
    447447      d_e_i_thd, d_e_i_trp 
    448     
     448 
    449449   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::       &  !: ice velocity  
    450450      d_u_ice_dyn, d_v_ice_dyn 
    … …  
    459459   INTEGER, PUBLIC, DIMENSION(jpm,2)              ::   &  !: 
    460460      ice_cat_bounds !: Matrix containing the integer upper and  
    461                      !: lower boundaries of ice thickness categories 
     461   !: lower boundaries of ice thickness categories 
    462462 
    463463   ! REMOVE 
    … …  
    474474   REAL(wp), PUBLIC, DIMENSION(0:jpl,jpm)         ::   &  !: 
    475475      hi_max_typ     !: Boundary of ice thickness categories  
    476                      !:in thickness space (same but specific for each ice type) 
     476   !:in thickness space (same but specific for each ice type) 
     477 
     478   !!-------------------------------------------------------------------------- 
     479   !! * Ice Run 
     480   !!-------------------------------------------------------------------------- 
     481   !! Namelist namicerun read in iceini 
     482   LOGICAL , PUBLIC  ::     & !!! ** init namelist (namicerun) ** 
     483      ln_limdyn   = .TRUE., & !: flag for ice dynamics (T) or not (F) 
     484      ln_nicep    = .TRUE.    !: flag for sea-ice points output (T) or not (F) 
     485   REAL(wp), PUBLIC  ::   &  !: 
     486      hsndif = 0.e0    ,  &  !: computation of temp. in snow (0) or not (9999) 
     487      hicdif = 0.e0    ,  &  !: computation of temp. in ice (0) or not (9999) 
     488      cai    = 1.40e-3 ,  &  !: atmospheric drag over sea ice 
     489      cao    = 1.00e-3       !: atmospheric drag over ocean 
     490   REAL(wp), PUBLIC, DIMENSION(2)  ::  &  !: 
     491      acrit  = (/ 1.e-06 , 1.e-06 /)    !: minimum fraction for leads in 
     492   !                                   !  north and south hemisphere 
    477493 
    478494   !!-------------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_3/iceini.F90

    r888 r921  
    3232 
    3333   !! * Share Module variables 
    34    LOGICAL , PUBLIC  ::     & !!! ** init namelist (namicerun) ** 
    35       ln_limdyn   = .TRUE., & !: flag for ice dynamics (T) or not (F) 
    36       ln_nicep    = .TRUE.    !: flag for sea-ice points output (T) or not (F) 
    3734   INTEGER , PUBLIC  ::   &  !: 
    3835      nstart ,            &  !: iteration number of the begining of the run  
    … …  
    4138      numit                  !: iteration number 
    4239   REAL(wp), PUBLIC  ::   &  !: 
    43       hsndif = 0.e0    ,  &  !: computation of temp. in snow (0) or not (9999) 
    44       hicdif = 0.e0    ,  &  !: computation of temp. in ice (0) or not (9999) 
    45       tpstot           ,  &  !: time of the run in seconds 
    46       cai    = 1.40e-3 ,  &  !: atmospheric drag over sea ice 
    47       cao    = 1.00e-3       !: atmospheric drag over ocean 
    48    REAL(wp), PUBLIC, DIMENSION(2)  ::  &  !: 
    49       acrit  = (/ 1.e-06 , 1.e-06 /)    !: minimum fraction for leads in  
    50       !                                   !  north and south hemisphere 
     40      tpstot                 !: time of the run in seconds 
    5141   !!---------------------------------------------------------------------- 
    5242   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008)  
    … …  
    7262 
    7363      CALL ice_run                    !  read in namelist some run parameters 
    74                   
     64 
    7565      ! Louvain la Neuve Ice model 
    7666      IF( nacc == 1 ) THEN 
    77           dtsd2   = nn_fsbc * rdtmin * 0.5 
    78           rdt_ice = nn_fsbc * rdtmin 
     67         dtsd2   = nn_fsbc * rdtmin * 0.5 
     68         rdt_ice = nn_fsbc * rdtmin 
    7969      ELSE 
    80           dtsd2   = nn_fsbc * rdt * 0.5 
    81           rdt_ice = nn_fsbc * rdt 
     70         dtsd2   = nn_fsbc * rdt * 0.5 
     71         rdt_ice = nn_fsbc * rdt 
    8272      ENDIF 
    8373 
    8474      CALL lim_msh                    ! ice mesh initialization 
    85       
     75 
    8676      CALL lim_itd_ini                ! initialize the ice thickness 
    87                                       ! distribution 
     77      ! distribution 
    8878      ! Initial sea-ice state 
    8979      IF( .NOT.ln_rstart ) THEN 
    … …  
    9282         CALL lim_istate              ! start from rest: sea-ice deduced from sst 
    9383         CALL lim_var_agg(1)          ! aggregate category variables in 
    94                                       ! bulk variables 
     84         ! bulk variables 
    9585         CALL lim_var_glo2eqv         ! convert global variables in equivalent 
    96                                       ! variables 
     86         ! variables 
    9787      ELSE 
    9888         CALL lim_rst_read            ! start from a restart file 
    … …  
    10898      alb_ice(:,:,:) = albege(:,:)      ! sea-ice albedo 
    10999# endif 
    110        
     100 
    111101      nstart = numit  + nn_fsbc       
    112102      nitrun = nitend - nit000 + 1  
    … …  
    138128      REWIND ( numnam_ice ) 
    139129      READ   ( numnam_ice , namicerun ) 
     130      ln_nicep = ln_nicep .AND. lwp 
    140131      IF(lwp) THEN 
    141132         WRITE(numout,*) 
    … …  
    150141         WRITE(numout,*) '   Several ice points in the ice or not in ocean.output = ', ln_nicep 
    151142      ENDIF 
    152        
     143 
    153144   END SUBROUTINE ice_run 
    154145 
    155146   SUBROUTINE lim_itd_ini 
    156         !!------------------------------------------------------------------ 
    157         !!                ***  ROUTINE lim_itd_ini *** 
    158         !! ** Purpose : 
    159         !!            Initializes the ice thickness distribution 
    160         !! ** Method  : 
    161         !!            Very simple. Currently there are no ice types in the 
    162         !!            model... 
    163         !! 
    164         !! ** Arguments : 
    165         !!           kideb , kiut : Starting and ending points on which the 
    166         !!                         the computation is applied 
    167         !! 
    168         !! ** Inputs / Ouputs : (global commons) 
    169         !! 
    170         !! ** External : 
    171         !! 
    172         !! ** References : 
    173         !! 
    174         !! ** History : 
    175         !!           (12-2005) Martin Vancoppenolle 
    176         !! 
    177         !!------------------------------------------------------------------ 
    178         !! * Arguments 
    179  
    180        !! * Local variables 
    181        INTEGER ::   jl,       &   ! ice category dummy loop index 
    182                     jm            ! ice types    dummy loop index 
    183  
    184        REAL(wp)  ::           &  ! constant values 
    185           zeps      =  1.0e-10,   & ! 
    186           zc1                 ,   & ! 
    187           zc2                 ,   & ! 
    188           zc3                 ,   & ! 
    189           zx1 
    190  
    191        WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution ' 
    192        WRITE(numout,*) '~~~~~~~~~~~~' 
    193  
    194 !!-- End of declarations 
    195 !!------------------------------------------------------------------------------ 
    196  
    197 !------------------------------------------------------------------------------! 
    198 ! 1) Ice thickness distribution parameters initialization     
    199 !------------------------------------------------------------------------------! 
     147      !!------------------------------------------------------------------ 
     148      !!                ***  ROUTINE lim_itd_ini *** 
     149      !! ** Purpose : 
     150      !!            Initializes the ice thickness distribution 
     151      !! ** Method  : 
     152      !!            Very simple. Currently there are no ice types in the 
     153      !!            model... 
     154      !! 
     155      !! ** Arguments : 
     156      !!           kideb , kiut : Starting and ending points on which the 
     157      !!                         the computation is applied 
     158      !! 
     159      !! ** Inputs / Ouputs : (global commons) 
     160      !! 
     161      !! ** External : 
     162      !! 
     163      !! ** References : 
     164      !! 
     165      !! ** History : 
     166      !!           (12-2005) Martin Vancoppenolle 
     167      !! 
     168      !!------------------------------------------------------------------ 
     169      !! * Arguments 
     170 
     171      !! * Local variables 
     172      INTEGER ::   jl,       &   ! ice category dummy loop index 
     173         jm            ! ice types    dummy loop index 
     174 
     175      REAL(wp)  ::           &  ! constant values 
     176         zeps      =  1.0e-10,   & ! 
     177         zc1                 ,   & ! 
     178         zc2                 ,   & ! 
     179         zc3                 ,   & ! 
     180         zx1 
     181 
     182      WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution ' 
     183      WRITE(numout,*) '~~~~~~~~~~~~' 
     184 
     185      !!-- End of declarations 
     186      !!------------------------------------------------------------------------------ 
     187 
     188      !------------------------------------------------------------------------------! 
     189      ! 1) Ice thickness distribution parameters initialization     
     190      !------------------------------------------------------------------------------! 
    200191 
    201192      !- Types boundaries (integer) 
    … …  
    266257      tn_ice(:,:,:) = t_su(:,:,:) 
    267258 
    268     END SUBROUTINE lim_itd_ini 
     259   END SUBROUTINE lim_itd_ini 
    269260 
    270261#else 

  • trunk/NEMO/LIM_SRC_3/limadv.F90

    r888 r921  
    6666         pdf ,       &  ! ??? 
    6767         pcrh           ! = 1. : lim_adv_x is called before lim_adv_y 
    68          !              ! = 0. : lim_adv_x is called after  lim_adv_y 
     68      !              ! = 0. : lim_adv_x is called after  lim_adv_y 
    6969      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  ::  & 
    7070         put            ! i-direction ice velocity at ocean U-point (m/s) 
    … …  
    114114      !  Calculate fluxes and moments between boxes i<-->i+1               
    115115      DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0  
    116 !i bug   DO ji = 1, jpim1  
    117 !i    DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0  
     116         !i bug   DO ji = 1, jpim1  
     117         !i    DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0  
    118118         DO ji = 1, jpi 
    119119            zbet(ji,jj)  =  MAX( rzero, SIGN( rone, put(ji,jj) ) ) 
    … …  
    142142 
    143143      DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0. 
    144 !i    DO jj = 1, fs_jpjm1                   !  Flux from i+1 to i when u LT 0. 
     144         !i    DO jj = 1, fs_jpjm1                   !  Flux from i+1 to i when u LT 0. 
    145145         DO ji = 1, fs_jpim1 
    146146            zalf          = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
    … …  
    228228      CALL lbc_lnk( psxy, 'T', 1. ) 
    229229 
    230      IF(ln_ctl) THEN 
     230      IF(ln_ctl) THEN 
    231231         CALL prt_ctl(tab2d_1=psm  , clinfo1=' lim_adv_x: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ') 
    232232         CALL prt_ctl(tab2d_1=psx  , clinfo1=' lim_adv_x: psx  :', tab2d_2=psxx, clinfo2=' psxx : ') 
    233233         CALL prt_ctl(tab2d_1=psy  , clinfo1=' lim_adv_x: psy  :', tab2d_2=psyy, clinfo2=' psyy : ') 
    234234         CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_x: psxy :') 
    235      ENDIF 
     235      ENDIF 
    236236 
    237237   END SUBROUTINE lim_adv_x 
    … …  
    260260         pdf,        &  ! ??? 
    261261         pcrh           ! = 1. : lim_adv_x is called before lim_adv_y 
    262          !              ! = 0. : lim_adv_x is called after  lim_adv_y 
     262      !              ! = 0. : lim_adv_x is called after  lim_adv_y 
    263263      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: & 
    264264         pvt            ! j-direction ice velocity at ocean V-point (m/s) 
    … …  
    285285      zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection. 
    286286 
    287        DO jj = 1, jpj 
    288           DO ji = 1, jpi 
    289              zslpmax = MAX( rzero, ps0(ji,jj) ) 
    290              zs1max  = 1.5 * zslpmax 
    291              zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 
    292              zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    293                 &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
    294              zin0    = ( 1.0 - MAX( rzero, sign ( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    295              ps0 (ji,jj) = zslpmax   
    296              psx (ji,jj)  = psx (ji,jj) * zin0 
    297              psxx(ji,jj)  = psxx(ji,jj) * zin0 
    298              psy (ji,jj) = zs1new * zin0 
    299              psyy(ji,jj) = zs2new * zin0 
    300              psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0 
    301           END DO 
    302        END DO 
    303  
    304        !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
    305        psm (:,:)  = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
    306  
    307        !  Calculate fluxes and moments between boxes j<-->j+1               
    308 !!bug  DO jj = 2, jpjm1 
    309        DO jj = 1, jpj 
    310           DO ji = 1, jpi 
    311 !!bug     DO ji = 1, jpim1 
    312              !  Flux from j to j+1 WHEN v GT 0    
    313              zbet(ji,jj)  =  MAX( rzero, SIGN( rone, pvt(ji,jj) ) ) 
    314              zalf         =  MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
    315              zalfq        =  zalf * zalf 
    316              zalf1        =  1.0 - zalf 
    317              zalf1q       =  zalf1 * zalf1 
    318              zfm (ji,jj)  =  zalf  * psm(ji,jj) 
    319              zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj) + zalf1 * ( psy(ji,jj)  + (zalf1-zalf) * psyy(ji,jj)  ) )  
    320              zfy (ji,jj)  =  zalfq *( psy(ji,jj) + 3.0*zalf1*psyy(ji,jj) ) 
    321              zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj) 
    322              zfx (ji,jj)  =  zalf  * ( psx(ji,jj) + zalf1 * psxy(ji,jj) ) 
    323              zfxy(ji,jj)  =  zalfq * psxy(ji,jj) 
    324              zfxx(ji,jj)  =  zalf  * psxx(ji,jj) 
    325  
    326              !  Readjust moments remaining in the box. 
    327              psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj) 
    328              ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj) 
    329              psy (ji,jj)  =  zalf1q * ( psy(ji,jj) -3.0 * zalf * psyy(ji,jj) ) 
    330              psyy(ji,jj)  =  zalf1 * zalf1q * psyy(ji,jj) 
    331              psx (ji,jj)  =  psx (ji,jj) - zfx(ji,jj) 
    332              psxx(ji,jj)  =  psxx(ji,jj) - zfxx(ji,jj) 
    333              psxy(ji,jj)  =  zalf1q * psxy(ji,jj) 
    334           END DO 
    335        END DO 
    336  
    337        DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
    338           DO ji = 1, jpi 
    339 !i     DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
    340 !i        DO ji = 2, jpim1 
    341              zalf          = ( MAX(rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
    342              zalg  (ji,jj) = zalf 
    343              zalfq         = zalf * zalf 
    344              zalf1         = 1.0 - zalf 
    345              zalg1 (ji,jj) = zalf1 
    346              zalf1q        = zalf1 * zalf1 
    347              zalg1q(ji,jj) = zalf1q 
    348              zfm   (ji,jj) = zfm (ji,jj) + zalf  * psm(ji,jj+1) 
    349              zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0(ji,jj+1) - zalf1 * (psy(ji,jj+1) - (zalf1 - zalf ) * psyy(ji,jj+1) ) ) 
    350              zfy   (ji,jj) = zfy (ji,jj) + zalfq * ( psy(ji,jj+1) - 3.0 * zalf1 * psyy(ji,jj+1) ) 
    351              zfyy  (ji,jj) = zfyy(ji,jj) + zalf  * zalfq * psyy(ji,jj+1) 
    352              zfx   (ji,jj) = zfx (ji,jj) + zalf  * ( psx(ji,jj+1) - zalf1 * psxy(ji,jj+1) ) 
    353              zfxy  (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1) 
    354              zfxx  (ji,jj) = zfxx(ji,jj) + zalf  * psxx(ji,jj+1) 
    355           END DO 
    356        END DO 
    357   
    358        !  Readjust moments remaining in the box.  
    359        DO jj = 2, jpj 
    360           DO ji = 1, jpi 
    361              zbt  =         zbet(ji,jj-1) 
    362              zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
    363              psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji,jj-1) ) 
    364              ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji,jj-1) ) 
    365              psy (ji,jj) = zalg1q(ji,jj-1) * ( psy(ji,jj) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj) ) 
    366              psyy(ji,jj) = zalg1 (ji,jj-1)  * zalg1q(ji,jj-1) * psyy(ji,jj) 
    367              psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) - zfx (ji,jj-1) ) 
    368              psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) - zfxx(ji,jj-1) ) 
    369              psxy(ji,jj) = zalg1q(ji,jj-1) * psxy(ji,jj) 
    370           END DO 
    371        END DO 
    372  
    373        !   Put the temporary moments into appropriate neighboring boxes.     
    374        DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0. 
    375           DO ji = 1, jpi 
    376              zbt  =         zbet(ji,jj-1) 
    377              zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
    378              psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj)  
    379              zalf        = zbt * zfm(ji,jj-1) / psm(ji,jj)  
    380              zalf1       = 1.0 - zalf 
    381              ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji,jj-1) 
    382              ps0(ji,jj)  = zbt * (ps0(ji,jj) + zf0(ji,jj-1)) + zbt1 * ps0(ji,jj) 
    383  
    384              psy(ji,jj)  = zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj) + 3.0 * ztemp )   & 
    385                 &        + zbt1 * psy(ji,jj)   
    386  
    387              psyy(ji,jj) = zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj)                             & 
    388                 &                 + 5.0 * ( zalf * zalf1 * ( psy(ji,jj) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) )   &  
    389                 &        + zbt1 * psyy(ji,jj) 
    390  
    391              psxy(ji,jj) = zbt  * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj)              & 
    392                                   + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj) ) )   & 
    393                          + zbt1 * psxy(ji,jj) 
    394              psx (ji,jj) = zbt * ( psx (ji,jj) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj) 
    395              psxx(ji,jj) = zbt * ( psxx(ji,jj) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj) 
    396           END DO 
    397        END DO 
    398  
    399        DO jj = 2, jpjm1                   !  Flux from j+1 to j IF v LT 0. 
    400           DO ji = 1, jpi 
    401              zbt  =         zbet(ji,jj) 
    402              zbt1 = ( 1.0 - zbet(ji,jj) ) 
    403              psm(ji,jj)  = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) ) 
    404              zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj) 
    405              zalf1       = 1.0 - zalf 
    406              ztemp       = -zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj) 
    407              ps0(ji,jj)  = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) ) 
    408              psy(ji,jj)  = zbt  * psy(ji,jj)  & 
    409                 &        + zbt1 * ( zalf*zfy(ji,jj) + zalf1 * psy(ji,jj) + 3.0 * ztemp ) 
    410              psyy(ji,jj) = zbt  * psyy(ji,jj)  & 
    411                 &        + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj)   & 
    412                 &                 + 5.0 *( zalf *zalf1 *( -psy(ji,jj) + zfy(ji,jj) ) + ( zalf1 - zalf ) * ztemp ) ) 
    413              psxy(ji,jj) = zbt  * psxy(ji,jj)   & 
    414                 &        + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)   & 
    415                 &                 + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj) ) ) 
    416              psx(ji,jj)  = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) + zfx (ji,jj) ) 
    417              psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) + zfxx(ji,jj) ) 
    418           END DO 
    419        END DO 
     287      DO jj = 1, jpj 
     288         DO ji = 1, jpi 
     289            zslpmax = MAX( rzero, ps0(ji,jj) ) 
     290            zs1max  = 1.5 * zslpmax 
     291            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 
     292            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
     293               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
     294            zin0    = ( 1.0 - MAX( rzero, sign ( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     295            ps0 (ji,jj) = zslpmax   
     296            psx (ji,jj)  = psx (ji,jj) * zin0 
     297            psxx(ji,jj)  = psxx(ji,jj) * zin0 
     298            psy (ji,jj) = zs1new * zin0 
     299            psyy(ji,jj) = zs2new * zin0 
     300            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0 
     301         END DO 
     302      END DO 
     303 
     304      !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
     305      psm (:,:)  = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
     306 
     307      !  Calculate fluxes and moments between boxes j<-->j+1               
     308      !!bug  DO jj = 2, jpjm1 
     309      DO jj = 1, jpj 
     310         DO ji = 1, jpi 
     311            !!bug     DO ji = 1, jpim1 
     312            !  Flux from j to j+1 WHEN v GT 0    
     313            zbet(ji,jj)  =  MAX( rzero, SIGN( rone, pvt(ji,jj) ) ) 
     314            zalf         =  MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
     315            zalfq        =  zalf * zalf 
     316            zalf1        =  1.0 - zalf 
     317            zalf1q       =  zalf1 * zalf1 
     318            zfm (ji,jj)  =  zalf  * psm(ji,jj) 
     319            zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj) + zalf1 * ( psy(ji,jj)  + (zalf1-zalf) * psyy(ji,jj)  ) )  
     320            zfy (ji,jj)  =  zalfq *( psy(ji,jj) + 3.0*zalf1*psyy(ji,jj) ) 
     321            zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj) 
     322            zfx (ji,jj)  =  zalf  * ( psx(ji,jj) + zalf1 * psxy(ji,jj) ) 
     323            zfxy(ji,jj)  =  zalfq * psxy(ji,jj) 
     324            zfxx(ji,jj)  =  zalf  * psxx(ji,jj) 
     325 
     326            !  Readjust moments remaining in the box. 
     327            psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj) 
     328            ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj) 
     329            psy (ji,jj)  =  zalf1q * ( psy(ji,jj) -3.0 * zalf * psyy(ji,jj) ) 
     330            psyy(ji,jj)  =  zalf1 * zalf1q * psyy(ji,jj) 
     331            psx (ji,jj)  =  psx (ji,jj) - zfx(ji,jj) 
     332            psxx(ji,jj)  =  psxx(ji,jj) - zfxx(ji,jj) 
     333            psxy(ji,jj)  =  zalf1q * psxy(ji,jj) 
     334         END DO 
     335      END DO 
     336 
     337      DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
     338         DO ji = 1, jpi 
     339            !i     DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
     340            !i        DO ji = 2, jpim1 
     341            zalf          = ( MAX(rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
     342            zalg  (ji,jj) = zalf 
     343            zalfq         = zalf * zalf 
     344            zalf1         = 1.0 - zalf 
     345            zalg1 (ji,jj) = zalf1 
     346            zalf1q        = zalf1 * zalf1 
     347            zalg1q(ji,jj) = zalf1q 
     348            zfm   (ji,jj) = zfm (ji,jj) + zalf  * psm(ji,jj+1) 
     349            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0(ji,jj+1) - zalf1 * (psy(ji,jj+1) - (zalf1 - zalf ) * psyy(ji,jj+1) ) ) 
     350            zfy   (ji,jj) = zfy (ji,jj) + zalfq * ( psy(ji,jj+1) - 3.0 * zalf1 * psyy(ji,jj+1) ) 
     351            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  * zalfq * psyy(ji,jj+1) 
     352            zfx   (ji,jj) = zfx (ji,jj) + zalf  * ( psx(ji,jj+1) - zalf1 * psxy(ji,jj+1) ) 
     353            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1) 
     354            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  * psxx(ji,jj+1) 
     355         END DO 
     356      END DO 
     357 
     358      !  Readjust moments remaining in the box.  
     359      DO jj = 2, jpj 
     360         DO ji = 1, jpi 
     361            zbt  =         zbet(ji,jj-1) 
     362            zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
     363            psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji,jj-1) ) 
     364            ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji,jj-1) ) 
     365            psy (ji,jj) = zalg1q(ji,jj-1) * ( psy(ji,jj) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj) ) 
     366            psyy(ji,jj) = zalg1 (ji,jj-1)  * zalg1q(ji,jj-1) * psyy(ji,jj) 
     367            psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) - zfx (ji,jj-1) ) 
     368            psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) - zfxx(ji,jj-1) ) 
     369            psxy(ji,jj) = zalg1q(ji,jj-1) * psxy(ji,jj) 
     370         END DO 
     371      END DO 
     372 
     373      !   Put the temporary moments into appropriate neighboring boxes.     
     374      DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0. 
     375         DO ji = 1, jpi 
     376            zbt  =         zbet(ji,jj-1) 
     377            zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
     378            psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj)  
     379            zalf        = zbt * zfm(ji,jj-1) / psm(ji,jj)  
     380            zalf1       = 1.0 - zalf 
     381            ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji,jj-1) 
     382            ps0(ji,jj)  = zbt * (ps0(ji,jj) + zf0(ji,jj-1)) + zbt1 * ps0(ji,jj) 
     383 
     384            psy(ji,jj)  = zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj) + 3.0 * ztemp )   & 
     385               &        + zbt1 * psy(ji,jj)   
     386 
     387            psyy(ji,jj) = zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj)                             & 
     388               &                 + 5.0 * ( zalf * zalf1 * ( psy(ji,jj) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) )   &  
     389               &        + zbt1 * psyy(ji,jj) 
     390 
     391            psxy(ji,jj) = zbt  * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj)              & 
     392               + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj) ) )   & 
     393               + zbt1 * psxy(ji,jj) 
     394            psx (ji,jj) = zbt * ( psx (ji,jj) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj) 
     395            psxx(ji,jj) = zbt * ( psxx(ji,jj) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj) 
     396         END DO 
     397      END DO 
     398 
     399      DO jj = 2, jpjm1                   !  Flux from j+1 to j IF v LT 0. 
     400         DO ji = 1, jpi 
     401            zbt  =         zbet(ji,jj) 
     402            zbt1 = ( 1.0 - zbet(ji,jj) ) 
     403            psm(ji,jj)  = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) ) 
     404            zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj) 
     405            zalf1       = 1.0 - zalf 
     406            ztemp       = -zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj) 
     407            ps0(ji,jj)  = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) ) 
     408            psy(ji,jj)  = zbt  * psy(ji,jj)  & 
     409               &        + zbt1 * ( zalf*zfy(ji,jj) + zalf1 * psy(ji,jj) + 3.0 * ztemp ) 
     410            psyy(ji,jj) = zbt  * psyy(ji,jj)  & 
     411               &        + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj)   & 
     412               &                 + 5.0 *( zalf *zalf1 *( -psy(ji,jj) + zfy(ji,jj) ) + ( zalf1 - zalf ) * ztemp ) ) 
     413            psxy(ji,jj) = zbt  * psxy(ji,jj)   & 
     414               &        + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)   & 
     415               &                 + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj) ) ) 
     416            psx(ji,jj)  = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) + zfx (ji,jj) ) 
     417            psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) + zfxx(ji,jj) ) 
     418         END DO 
     419      END DO 
    420420 
    421421      !-- Lateral boundary conditions 
    … …  
    428428      CALL lbc_lnk( psxy, 'T', 1. ) 
    429429 
    430      IF(ln_ctl) THEN 
     430      IF(ln_ctl) THEN 
    431431         CALL prt_ctl(tab2d_1=psm  , clinfo1=' lim_adv_y: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ') 
    432432         CALL prt_ctl(tab2d_1=psx  , clinfo1=' lim_adv_y: psx  :', tab2d_2=psxx, clinfo2=' psxx : ') 
    433433         CALL prt_ctl(tab2d_1=psy  , clinfo1=' lim_adv_y: psy  :', tab2d_2=psyy, clinfo2=' psyy : ') 
    434434         CALL prt_ctl(tab2d_1=psxy , clinfo1=' lim_adv_y: psxy :') 
    435      ENDIF 
     435      ENDIF 
    436436 
    437437   END SUBROUTINE lim_adv_y 

  • trunk/NEMO/LIM_SRC_3/limcons.F90

    r834 r921  
    4242CONTAINS 
    4343 
    44 !=============================================================================== 
     44   !=============================================================================== 
    4545 
    4646   SUBROUTINE lim_column_sum(nsum,xin,xout) 
    47 !     !!------------------------------------------------------------------- 
    48 !     !!               ***  ROUTINE lim_column_sum *** 
    49 !     !! 
    50 !     !! ** Purpose : Compute the sum of xin over nsum categories 
    51 !     !! 
    52 !     !! ** Method  : Arithmetics 
    53 !     !! 
    54 !     !! ** Action  : Gets xin(ji,jj,jl) and computes xout(ji,jj) 
    55 !     !! 
    56 !     !! History : 
    57 !     !!   author: William H. Lipscomb, LANL 
    58 !     !!   2.1  !  04-06  (M. Vancoppenolle)   Energy Conservation  
    59 !     !!--------------------------------------------------------------------- 
    60 !     !! * Local variables 
     47      !     !!------------------------------------------------------------------- 
     48      !     !!               ***  ROUTINE lim_column_sum *** 
     49      !     !! 
     50      !     !! ** Purpose : Compute the sum of xin over nsum categories 
     51      !     !! 
     52      !     !! ** Method  : Arithmetics 
     53      !     !! 
     54      !     !! ** Action  : Gets xin(ji,jj,jl) and computes xout(ji,jj) 
     55      !     !! 
     56      !     !! History : 
     57      !     !!   author: William H. Lipscomb, LANL 
     58      !     !!   2.1  !  04-06  (M. Vancoppenolle)   Energy Conservation  
     59      !     !!--------------------------------------------------------------------- 
     60      !     !! * Local variables 
    6161      INTEGER, INTENT(in) ::     & 
    62            nsum                  ! number of categories/layers 
     62         nsum                  ! number of categories/layers 
    6363 
    6464      REAL (wp), DIMENSION(jpi, jpj, jpl), INTENT(IN) ::   & 
    65            xin                   ! input field 
     65         xin                   ! input field 
    6666 
    6767      REAL (wp), DIMENSION(jpi, jpj), INTENT(OUT) ::  & 
    68            xout                  ! output field 
     68         xout                  ! output field 
    6969      INTEGER ::                 & 
    70            ji, jj, jl         ! horizontal indices 
    71  
    72 !     !!--------------------------------------------------------------------- 
    73 !     WRITE(numout,*) ' lim_column_sum ' 
    74 !     WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 
     70         ji, jj, jl         ! horizontal indices 
     71 
     72      !     !!--------------------------------------------------------------------- 
     73      !     WRITE(numout,*) ' lim_column_sum ' 
     74      !     WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 
    7575 
    7676      xout(:,:) = 0.00 
    … …  
    8686   END SUBROUTINE lim_column_sum 
    8787 
    88 !=============================================================================== 
     88   !=============================================================================== 
    8989 
    9090   SUBROUTINE lim_column_sum_energy(nsum,nlay,xin,xout) 
    … …  
    106106      !! * Local variables 
    107107      INTEGER, INTENT(in) ::  & 
    108            nsum,              &  !: number of categories 
    109            nlay                  !: number of vertical layers 
     108         nsum,              &  !: number of categories 
     109         nlay                  !: number of vertical layers 
    110110 
    111111      REAL (wp), DIMENSION(jpi, jpj, jkmax, jpl), INTENT(IN) :: & 
    112            xin                   !: input field 
     112         xin                   !: input field 
    113113 
    114114      REAL (wp), DIMENSION(jpi, jpj), INTENT(OUT) ::  & 
    115            xout                  !: output field 
     115         xout                  !: output field 
    116116 
    117117      INTEGER ::              & 
    118            ji, jj,            &  !: horizontal indices 
    119            jk, jl                !: layer and category  indices 
    120       !!--------------------------------------------------------------------- 
    121  
    122 !     WRITE(numout,*) ' lim_column_sum_energy ' 
    123 !     WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~ ' 
     118         ji, jj,            &  !: horizontal indices 
     119         jk, jl                !: layer and category  indices 
     120      !!--------------------------------------------------------------------- 
     121 
     122      !     WRITE(numout,*) ' lim_column_sum_energy ' 
     123      !     WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~ ' 
    124124 
    125125      xout(:,:) = 0.00 
    … …  
    137137   END SUBROUTINE lim_column_sum_energy 
    138138 
    139 !=============================================================================== 
    140     
     139   !=============================================================================== 
     140 
    141141   SUBROUTINE lim_cons_check(x1, x2, max_err, fieldid) 
    142142      !!------------------------------------------------------------------- 
    … …  
    206206                  WRITE (numout,*) ' Point         : ', ji, jj  
    207207                  WRITE (numout,*) ' lat, lon      : ', gphit(ji,jj), &  
    208                                                         glamt(ji,jj) 
     208                     glamt(ji,jj) 
    209209                  WRITE (numout,*) ' Initial value : ', x1(ji,jj) 
    210210                  WRITE (numout,*) ' Final value   : ', x2(ji,jj) 

  • trunk/NEMO/LIM_SRC_3/limdia.F90

    r895 r921  
    9595      !!------------------------------------------------------------------- 
    9696      !! * Local variables 
    97        INTEGER  ::   jv,ji,jj,jl ! dummy loop indices 
    98        REAL(wp), DIMENSION(jpinfmx) ::  &  
    99           vinfor           ! temporary working space  
    100        REAL(wp) ::    & 
    101           zshift_date   , & ! date from the minimum ice extent 
    102           zday, zday_min, & ! current day, day of minimum extent 
    103           zafy, zamy,     & ! temporary area of fy and my ice 
    104           zindb 
    105        !!------------------------------------------------------------------- 
    106  
    107        ! 0) date from the minimum of ice extent 
    108        !--------------------------------------- 
    109        zday_min = 273.0        ! zday_min = date of minimum extent, here September 30th 
    110        zday = FLOAT(numit-nit000) * rdt_ice / ( 86400.0 * FLOAT(nn_fsbc) ) 
    111        IF (zday.GT.zday_min) THEN  
    112           zshift_date  =  zday - zday_min 
    113        ELSE 
    114           zshift_date  =  zday - (365.0 - zday_min) 
    115        ENDIF 
    116  
    117        IF( numit == nstart )   CALL lim_dia_init   ! initialisation of ice_evolu file       
    118  
    119        ! temporal diagnostics  
    120        vinfor(1) = REAL(numit) 
    121        vinfor(2) = nyear 
    122   
    123        ! put everything to zero 
    124        DO jv = nbvt + 1, nvinfo 
    125           vinfor(jv) = 0.0 
    126        END DO 
    127  
    128        !!------------------------------------------------------------------- 
    129        !! 1) Northern hemisphere 
    130        !!------------------------------------------------------------------- 
    131        !! 1.1) Diagnostics independent on age 
    132        !!------------------------------------ 
    133        DO jj = njeq, jpjm1 
    134           DO ji = fs_2, fs_jpim1   ! vector opt. 
    135              IF( tms(ji,jj) == 1 ) THEN 
    136                 vinfor(3)  = vinfor(3)  + at_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice area 
    137                 IF (at_i(ji,jj).GT.0.15) vinfor(5) = vinfor(5) + aire(ji,jj) / 1.0e12 !ice extent 
    138                 vinfor(7)  = vinfor(7)  + vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice volume 
    139                 vinfor(9)  = vinfor(9)  + vt_s(ji,jj)*aire(ji,jj) / 1.0e12 !snow volume 
    140                 vinfor(15) = vinfor(15) + ot_i(ji,jj) *vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean age 
    141                 vinfor(29) = vinfor(29) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean salinity 
    142                 ! the computation of this diagnostic is not reliable 
    143                 vinfor(31) = vinfor(31) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
    144                                                         v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12  
    145                 vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) / 1.0e12 !salt flux 
    146                 vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) / 1.0e12 !brine drainage flux 
    147                 vinfor(57) = vinfor(57) + fseqv(ji,jj)*aire(ji,jj) / 1.0e12 !equivalent salt flux 
    148                 vinfor(59) = vinfor(59) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
    149                 vinfor(61) = vinfor(61) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
    150                 vinfor(65) = vinfor(65) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12  ! snow temperature 
    151                 vinfor(67) = vinfor(67) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12       ! ice heat content 
    152                 vinfor(69) = vinfor(69) + v_i(ji,jj,1)*aire(ji,jj) / 1.0e12 !ice volume 
    153                 vinfor(71) = vinfor(71) + v_i(ji,jj,2)*aire(ji,jj) / 1.0e12 !ice volume 
    154                 vinfor(73) = vinfor(73) + v_i(ji,jj,3)*aire(ji,jj) / 1.0e12 !ice volume 
    155                 vinfor(75) = vinfor(75) + v_i(ji,jj,4)*aire(ji,jj) / 1.0e12 !ice volume 
    156                 vinfor(77) = vinfor(77) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume 
    157                 vinfor(79) = 0.0 
    158                 vinfor(81) = vinfor(81) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
    159              ENDIF 
    160           END DO 
    161        END DO 
    162  
    163        DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
    164           DO jj = njeq, jpjm1 
    165              DO ji = fs_2, fs_jpim1   ! vector opt. 
    166                 IF( tms(ji,jj) == 1 ) THEN 
    167                    vinfor(11) = vinfor(11) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !undef def ice volume 
    168                 ENDIF 
    169              END DO 
    170           END DO 
    171        END DO 
    172  
    173        vinfor(13) = 0.0 
    174  
    175        vinfor(15) = vinfor(15) / MAX(vinfor(7),epsi06) ! these have to be divided by total ice volume to have the 
    176        vinfor(29) = vinfor(29) / MAX(vinfor(7),epsi06) ! right value 
    177        vinfor(31) = SQRT( vinfor(31) / MAX( vinfor(7) , epsi06 ) ) 
    178        vinfor(67) = vinfor(67) / MAX(vinfor(7),epsi06) 
    179  
    180        vinfor(53) = vinfor(53) / MAX(vinfor(5),epsi06) ! these have to be divided by total ice extent to have the 
    181        vinfor(55) = vinfor(55) / MAX(vinfor(5),epsi06) ! right value  
    182        vinfor(57) = vinfor(57) / MAX(vinfor(5),epsi06) !  
    183        vinfor(79) = vinfor(79) / MAX(vinfor(5),epsi06) ! 
    184  
    185        zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(3))) ! 
    186        vinfor(59) = zindb*vinfor(59) / MAX(vinfor(3),epsi06) ! divide by ice area 
    187        vinfor(61) = zindb*vinfor(61) / MAX(vinfor(3),epsi06) ! 
    188  
    189        zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(9))) ! 
    190        vinfor(65) = zindb*vinfor(65) / MAX(vinfor(9),epsi06) ! divide it by snow volume 
    191  
    192  
    193        DO jl = 1, jpl 
    194           DO jj = njeq, jpjm1 
    195              DO ji = fs_2, fs_jpim1   ! vector opt. 
    196                 IF( tms(ji,jj) == 1 ) THEN 
    197                    vinfor(33) = vinfor(33) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume 
    198                    vinfor(35) = vinfor(35) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume 
    199                 ENDIF 
    200              END DO 
    201           END DO 
    202        END DO 
    203  
    204        DO jj = njeq, jpjm1 
    205           DO ji = fs_2, fs_jpim1   ! vector opt. 
    206                 IF( tms(ji,jj) == 1 ) THEN 
    207                    vinfor(37) = vinfor(37) + diag_sni_gr(ji,jj)*aire(ji,jj) / 1.0e12 !th growth rates 
    208                    vinfor(39) = vinfor(39) + diag_lat_gr(ji,jj)*aire(ji,jj) / 1.0e12  
    209                    vinfor(41) = vinfor(41) + diag_bot_gr(ji,jj)*aire(ji,jj) / 1.0e12 
    210                    vinfor(43) = vinfor(43) + diag_dyn_gr(ji,jj)*aire(ji,jj) / 1.0e12  
    211                    vinfor(45) = vinfor(45) + dv_dt_thd(ji,jj,5)*aire(ji,jj) / 1.0e12 
    212                    vinfor(47) = vinfor(47) + v_newice(ji,jj) *aire(ji,jj) / 1.0e12 / rdt_ice ! volume acc in OW 
    213                 ENDIF 
    214           END DO 
    215        END DO 
    216  
    217        DO jl = 1, jpl 
    218           DO jj = njeq, jpjm1 
    219              DO ji = fs_2, fs_jpim1   ! vector opt. 
    220                 IF( tms(ji,jj) == 1 ) THEN 
    221                    vinfor(63) = vinfor(63) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 
    222                 ENDIF 
    223              END DO 
    224           END DO 
    225        END DO 
    226        vinfor(63) = vinfor(63) / MAX(vinfor(3),epsi06) ! these have to be divided by total ice area 
    227  
    228        !! 1.2) Diagnostics dependent on age 
    229        !!------------------------------------ 
    230        DO jj = njeq, jpjm1 
    231           DO ji = fs_2, fs_jpim1   ! vector opt. 
    232              IF( tms(ji,jj) == 1 ) THEN 
    233                 zafy = 0.0 
    234                 zamy = 0.0 
    235                 DO jl = 1, jpl 
    236                    IF ((o_i(ji,jj,jl) - zshift_date).LT.0.0) THEN 
    237                       vinfor(17) = vinfor(17) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice area 
    238                       vinfor(25) = vinfor(25) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice volume 
    239                       vinfor(49) = vinfor(49) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !FY ice salinity 
    240                       zafy = zafy + a_i(ji,jj,jl) 
    241                    ENDIF 
    242                    IF ((o_i(ji,jj,jl) - zshift_date).GT.0.0) THEN 
    243                       vinfor(19) = vinfor(19) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12    ! MY ice area 
    244                       vinfor(27) = vinfor(27) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! MY ice volume 
    245                       vinfor(51) = vinfor(51) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !MY ice salinity 
    246                       zamy = zamy + a_i(ji,jj,jl) 
    247                    ENDIF 
    248                 END DO 
    249                 IF ((at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN 
    250                    vinfor(21) = vinfor(21) + aire(ji,jj) / 1.0e12 ! Seasonal ice extent 
    251                 ENDIF 
    252                 IF ((at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN 
    253                    vinfor(23) = vinfor(23) + aire(ji,jj) / 1.0e12 ! Perennial ice extent 
    254                 ENDIF 
    255              ENDIF 
    256           END DO 
    257        END DO 
    258        zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(25))) !=0 if no multiyear ice 1 if yes 
    259        vinfor(49) = zindb*vinfor(49) / MAX(vinfor(25),epsi06) 
    260        zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(27))) !=0 if no multiyear ice 1 if yes 
    261        vinfor(51) = zindb*vinfor(51) / MAX(vinfor(27),epsi06) 
    262         
    263        !! Fram Strait Export 
    264        !! 83 = area export 
    265        !! 84 = volume export 
    266        !! Fram strait in ORCA2 = 5 points 
    267        !! export = -v_ice*e1t*ddtb*at_i or -v_ice*e1t*ddtb*at_i*h_i 
    268        jj = 136 ! C grid 
    269        vinfor(83) = 0.0 
    270        vinfor(84) = 0.0 
    271        DO ji = 134, 138 
    272           vinfor(83) = vinfor(83) - v_ice(ji,jj) * &  
    273                                       e1t(ji,jj)*at_i(ji,jj)*rdt_ice / 1.0e12 
    274           vinfor(84) = vinfor(84) - v_ice(ji,jj) * &  
    275                                       e1t(ji,jj)*vt_i(ji,jj)*rdt_ice / 1.0e12 
    276        END DO 
    277  
    278        !!------------------------------------------------------------------- 
    279        !! 2) Southern hemisphere 
    280        !!------------------------------------------------------------------- 
    281        !! 2.1) Diagnostics independent on age 
    282        !!------------------------------------ 
    283        DO jj = 2, njeqm1 
    284           DO ji = fs_2, fs_jpim1   ! vector opt. 
    285              IF( tms(ji,jj) == 1 ) THEN 
    286                 vinfor(4)  = vinfor(4)  + at_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice area 
    287                 IF (at_i(ji,jj).GT.0.15) vinfor(6) = vinfor(6) + aire(ji,jj) / 1.0e12 !ice extent 
    288                 vinfor(8)  = vinfor(8)  + vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice volume 
    289                 vinfor(10) = vinfor(10) + vt_s(ji,jj)*aire(ji,jj) / 1.0e12 !snow volume 
    290                 vinfor(16) = vinfor(16) + ot_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean age 
    291                 vinfor(30) = vinfor(30) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean salinity 
    292                 ! this diagnostic is not well computed (weighted by vol instead 
    293                 ! of area) 
    294                 vinfor(32) = vinfor(32) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
    295                                                         v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 !ice vel 
    296                 vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) / 1.0e12 ! Total salt flux 
    297                 vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) / 1.0e12 ! Brine drainage salt flux 
    298                 vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) / 1.0e12 ! Equivalent salt flux 
    299                 vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
    300                 vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
    301                 vinfor(66) = vinfor(66) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! snow temperature 
    302                 vinfor(68) = vinfor(68) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! ice enthalpy 
    303                 vinfor(70) = vinfor(70) + v_i(ji,jj,1)*aire(ji,jj) / 1.0e12 !ice volume 
    304                 vinfor(72) = vinfor(72) + v_i(ji,jj,2)*aire(ji,jj) / 1.0e12 !ice volume 
    305                 vinfor(74) = vinfor(74) + v_i(ji,jj,3)*aire(ji,jj) / 1.0e12 !ice volume 
    306                 vinfor(76) = vinfor(76) + v_i(ji,jj,4)*aire(ji,jj) / 1.0e12 !ice volume 
    307                 vinfor(78) = vinfor(78) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume 
    308                 vinfor(80) = 0.0 
    309                 vinfor(82) = vinfor(82) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
    310              ENDIF 
    311           END DO 
    312        END DO 
    313  
    314        DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
    315           DO jj = 2, njeqm1 
    316              DO ji = fs_2, fs_jpim1   ! vector opt. 
    317                 vinfor(12) = vinfor(12) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !undef def ice volume 
    318              END DO 
    319           END DO 
    320        END DO 
    321  
    322        vinfor(14) = 0.0 
    323  
    324        zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(8)))  
    325        vinfor(16) = zindb * vinfor(16) / MAX(vinfor(8),epsi06) ! these have to be divided by ice vol 
    326        vinfor(30) = zindb * vinfor(30) / MAX(vinfor(8),epsi06) !  
    327        vinfor(32) = zindb * SQRT( vinfor(32) / MAX( vinfor(8) , epsi06 ) ) 
    328        vinfor(68) = zindb * vinfor(68) / MAX(vinfor(8),epsi06) !  
    329  
    330        zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(6)))  
    331        vinfor(54) = zindb * vinfor(54) / MAX(vinfor(6),epsi06) ! these have to be divided by ice extt 
    332        vinfor(56) = zindb * vinfor(56) / MAX(vinfor(6),epsi06) !  
    333        vinfor(58) = zindb * vinfor(58) / MAX(vinfor(6),epsi06) !  
    334        vinfor(80) = zindb * vinfor(80) / MAX(vinfor(6),epsi06) ! 
    335 !      vinfor(84) = vinfor(84) / vinfor(6) ! 
    336   
    337        zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4))) ! 
    338        vinfor(60) = zindb*vinfor(60) / ( MAX(vinfor(4), epsi06) ) ! divide by ice area 
    339        vinfor(62) = zindb*vinfor(62) / ( MAX(vinfor(4), epsi06) ) ! 
    340  
    341        zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(10))) ! 
    342        vinfor(66) = zindb*vinfor(66) / MAX(vinfor(10),epsi06) ! divide it by snow volume 
    343  
    344        DO jl = 1, jpl 
    345           DO jj = 2, njeqm1 
    346              DO ji = fs_2, fs_jpim1   ! vector opt. 
    347                 IF( tms(ji,jj) == 1 ) THEN 
    348                    vinfor(34) = vinfor(34) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume 
    349                    vinfor(36) = vinfor(36) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume 
    350                 ENDIF 
    351              END DO 
    352           END DO 
    353        END DO 
    354  
    355        DO jj = 2, njeqm1 
    356           DO ji = fs_2, fs_jpim1   ! vector opt. 
    357                 IF( tms(ji,jj) == 1 ) THEN 
    358                    vinfor(38) = vinfor(38) + diag_sni_gr(ji,jj)*aire(ji,jj) / 1.0e12 !th growth rates 
    359                    vinfor(40) = vinfor(40) + diag_lat_gr(ji,jj)*aire(ji,jj) / 1.0e12  
    360                    vinfor(42) = vinfor(42) + diag_bot_gr(ji,jj)*aire(ji,jj) / 1.0e12 
    361                    vinfor(44) = vinfor(44) + diag_dyn_gr(ji,jj)*aire(ji,jj) / 1.0e12  
    362                    vinfor(46) = vinfor(46) + dv_dt_thd(ji,jj,5)*aire(ji,jj) / 1.0e12 
    363                    vinfor(48) = vinfor(48) + v_newice(ji,jj) *aire(ji,jj) / 1.0e12 / rdt_ice ! volume acc in OW 
    364                 ENDIF 
    365           END DO 
    366        END DO 
    367  
    368  
    369        DO jl = 1, jpl 
    370           DO jj = 2, njeqm1 
    371              DO ji = fs_2, fs_jpim1   ! vector opt. 
    372                 IF( tms(ji,jj) == 1 ) THEN 
    373                    vinfor(64) = vinfor(64) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 
    374                 ENDIF 
    375              END DO 
    376           END DO 
    377        END DO 
    378        zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4))) ! 
    379        vinfor(64) = zindb * vinfor(64) / MAX(vinfor(4),epsi06) ! divide by ice extt 
    380        !! 2.2) Diagnostics dependent on age 
    381        !!------------------------------------ 
    382        DO jj = 2, njeqm1 
    383           DO ji = fs_2, fs_jpim1   ! vector opt. 
    384              IF( tms(ji,jj) == 1 ) THEN 
    385                 zafy = 0.0 
    386                 zamy = 0.0 
    387                 DO jl = 1, jpl 
    388                    IF ((o_i(ji,jj,jl) - zshift_date).LT.0.0) THEN 
    389                       vinfor(18) = vinfor(18) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice area 
    390                       vinfor(26) = vinfor(26) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice volume 
    391                       zafy = zafy + a_i(ji,jj,jl) 
    392                       vinfor(50) = vinfor(50) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !FY ice salinity 
    393                    ENDIF 
    394                    IF ((o_i(ji,jj,jl) - zshift_date).GT.0.0) THEN 
    395                       vinfor(20) = vinfor(20) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12    ! MY ice area 
    396                       vinfor(28) = vinfor(28) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 
    397                       vinfor(52) = vinfor(52) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !FY ice salinity 
    398                       zamy = zamy + a_i(ji,jj,jl) 
    399                    ENDIF 
    400                 END DO ! jl 
    401                 IF ((at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN 
    402                    vinfor(22) = vinfor(22) + aire(ji,jj) / 1.0e12 ! Seasonal ice extent 
    403                 ENDIF 
    404                 IF ((at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN 
    405                    vinfor(24) = vinfor(24) + aire(ji,jj) / 1.0e12 ! Perennial ice extent 
    406                 ENDIF 
    407              ENDIF ! tms 
    408           END DO ! jj 
    409        END DO ! ji 
    410        zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(26))) !=0 if no multiyear ice 1 if yes 
    411        vinfor(50) = zindb*vinfor(50) / MAX(vinfor(26),epsi06) 
    412        zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(28))) !=0 if no multiyear ice 1 if yes 
    413        vinfor(52) = zindb*vinfor(52) / MAX(vinfor(28),epsi06) 
    414  
    415        !  Accumulation before averaging  
    416        DO jv = 1, nvinfo 
    417           vinfom(jv) = vinfom(jv) + vinfor(jv) 
    418        END DO 
    419        naveg = naveg + 1   
    420      
    421        ! oututs on file ice_evolu     
    422 !MV      IF( MOD( numit , ninfo ) == 0 ) THEN 
    423           WRITE(numevo_ice,fmtw) ( titvar(jv), vinfom(jv)/naveg, jv = 1, nvinfo ) 
    424           naveg = 0 
    425           DO jv = 1, nvinfo 
    426              vinfom(jv)=0.0 
    427           END DO 
    428 !MV      ENDIF 
    429    
    430     END SUBROUTINE lim_dia 
    431   
    432     SUBROUTINE lim_dia_init 
    433        !!------------------------------------------------------------------- 
    434        !!                  ***  ROUTINE lim_dia_init  *** 
    435        !!              
    436        !! ** Purpose : Preparation of the file ice_evolu for the output of 
    437        !!      the temporal evolution of key variables 
    438        !! 
    439        !! ** input   : Namelist namicedia 
    440        !! 
    441        !! history : 
    442        !!  8.5  ! 03-08 (C. Ethe) original code 
    443        !!  9.0  ! 08-03 (M. Vancoppenolle) LIM3 
    444        !!------------------------------------------------------------------- 
    445        NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy 
    446  
    447        INTEGER  ::   jv   ,     &  ! dummy loop indice 
    448           &          ntot ,     & 
    449           &          ndeb ,     & 
    450           &          irecl 
    451  
    452        REAL(wp) ::   zxx0, zxx1    ! temporary scalars 
    453  
    454        CHARACTER(len=jpchinf) ::   titinf 
    455        CHARACTER(len=50)      ::   clname 
    456        !!------------------------------------------------------------------- 
    457  
    458  
    459        ! Read Namelist namicedia 
    460        REWIND ( numnam_ice ) 
    461        READ   ( numnam_ice  , namicedia ) 
    462        IF(lwp) THEN 
    463           WRITE(numout,*) 
    464           WRITE(numout,*) 'lim_dia_init : ice parameters for ice diagnostics ' 
    465           WRITE(numout,*) '~~~~~~~~~~~~' 
    466           WRITE(numout,*) '   format of the output values                                 fmtinf = ', fmtinf 
    467           WRITE(numout,*) '   number of variables written in one line                     nfrinf = ', nfrinf  
    468           WRITE(numout,*) '   Instantaneous values of ice evolution or averaging          ntmoy  = ', ntmoy 
    469           WRITE(numout,*) '   frequency of ouputs on file ice_evolu in case of averaging  ninfo  = ', ninfo 
    470        ENDIF 
    471  
    472        ! masked grid cell area 
    473        aire(:,:) = area(:,:) * tms(:,:) 
    474  
    475        ! Titles of ice key variables : 
    476        titvar(1) = 'NoIt'  ! iteration number 
    477        titvar(2) = 'T yr'  ! time step in years 
    478        nbvt = 2            ! number of time variables 
    479  
    480        titvar(3) = 'AI_N'  ! sea ice area in the northern Hemisp.(10^12 km2) 
    481        titvar(4) = 'AI_S'  ! sea ice area in the southern Hemisp.(10^12 km2) 
    482        titvar(5) = 'EI_N'  ! sea ice extent (15%) in the northern Hemisp.(10^12 km2) 
    483        titvar(6) = 'EI_S'  ! sea ice extent (15%) in the southern Hemisp.(10^12 km2) 
    484        titvar(7) = 'VI_N'  ! sea ice volume in the northern Hemisp.(10^3 km3) 
    485        titvar(8) = 'VI_S'  ! sea ice volume in the southern Hemisp.(10^3 km3) 
    486        titvar(9) = 'VS_N'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3) 
    487        titvar(10)= 'VS_S'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3) 
    488        titvar(11)= 'VuIN'  ! undeformed sea ice volume in the northern Hemisp.(10^3 km3) 
    489        titvar(12)= 'VuIS'  ! undeformed sea ice volume in the southern Hemisp.(10^3 km3) 
    490        titvar(13)= 'VdIN'  ! deformed sea ice volume in the northern Hemisp.(10^3 km3) 
    491        titvar(14)= 'VdIS'  ! deformed sea ice volume in the southern Hemisp.(10^3 km3) 
    492        titvar(15)= 'OI_N'  ! sea ice mean age in the northern Hemisp.(years) 
    493        titvar(16)= 'OI_S'  ! sea ice mean age in the southern Hemisp.(years) 
    494        titvar(17)= 'AFYN'  ! total FY ice area northern Hemisp.(10^12 km2) 
    495        titvar(18)= 'AFYS'  ! total FY ice area southern Hemisp.(10^12 km2) 
    496        titvar(19)= 'AMYN'  ! total MY ice area northern Hemisp.(10^12 km2) 
    497        titvar(20)= 'AMYS'  ! total MY ice area southern Hemisp.(10^12 km2) 
    498        titvar(21)= 'EFYN'  ! total FY ice extent northern Hemisp.(10^12 km2) (with more 50% FY ice) 
    499        titvar(22)= 'EFYS'  ! total FY ice extent southern Hemisp.(10^12 km2) (with more 50% FY ice) 
    500        titvar(23)= 'EMYN'  ! total MY ice extent northern Hemisp.(10^12 km2) (with more 50% MY ice) 
    501        titvar(24)= 'EMYS'  ! total MY ice extent southern Hemisp.(10^12 km2) (with more 50% MY ice) 
    502        titvar(25)= 'VFYN'  ! total undeformed FY ice volume northern Hemisp.(10^3 km3)  
    503        titvar(26)= 'VFYS'  ! total undeformed FY ice volume southern Hemisp.(10^3 km3) 
    504        titvar(27)= 'VMYN'  ! total undeformed MY ice volume northern Hemisp.(10^3 km3)  
    505        titvar(28)= 'VMYS'  ! total undeformed MY ice volume southern Hemisp.(10^3 km3)  
    506        titvar(29)= 'IS_N'  ! sea ice mean salinity in the northern hemisphere (ppt)   
    507        titvar(30)= 'IS_S'  ! sea ice mean salinity in the southern hemisphere (ppt)   
    508        titvar(31)= 'IVeN'  ! sea ice mean velocity in the northern hemisphere (m/s)  
    509        titvar(32)= 'IVeS'  ! sea ice mean velocity in the southern hemisphere (m/s)  
    510        titvar(33)= 'DVDN'  ! variation of sea ice volume due to dynamics in the northern hemisphere 
    511        titvar(34)= 'DVDS'  ! variation of sea ice volume due to dynamics in the southern hemisphere 
    512        titvar(35)= 'DVTN'  ! variation of sea ice volume due to thermo in the   northern hemisphere 
    513        titvar(36)= 'DVTS'  ! variation of sea ice volume due to thermo in the   southern hemisphere 
    514        titvar(37)= 'TG1N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 1   
    515        titvar(38)= 'TG1S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 1   
    516        titvar(39)= 'TG2N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 2   
    517        titvar(40)= 'TG2S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 2   
    518        titvar(41)= 'TG3N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 3   
    519        titvar(42)= 'TG3S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 3   
    520        titvar(43)= 'TG4N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 4   
    521        titvar(44)= 'TG4S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 4   
    522        titvar(45)= 'TG5N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 5   
    523        titvar(46)= 'TG5S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 5   
    524        titvar(47)= 'LA_N'  ! lateral accretion growth rate, northern hemisphere 
    525        titvar(48)= 'LA_S'  ! lateral accretion growth rate, southern hemisphere  
    526        titvar(49)= 'SF_N'  ! Salinity FY, NH  
    527        titvar(50)= 'SF_S'  ! Salinity FY, SH  
    528        titvar(51)= 'SF_N'  ! Salinity MY, NH  
    529        titvar(52)= 'SF_S'  ! Salinity MY, SH  
    530        titvar(53)= 'Fs_N'  ! Total salt flux NH 
    531        titvar(54)= 'Fs_S'  ! Total salt flux SH 
    532        titvar(55)= 'FsbN'  ! Salt - brine drainage flux NH 
    533        titvar(56)= 'FsbS'  ! Salt - brine drainage flux SH 
    534        titvar(57)= 'FseN'  ! Salt - Equivalent salt flux NH 
    535        titvar(58)= 'FseS'  ! Salt - Equivalent salt flux SH 
    536        titvar(59)= 'SSTN'  ! SST, NH 
    537        titvar(60)= 'SSTS'  ! SST, SH 
    538        titvar(61)= 'SSSN'  ! SSS, NH 
    539        titvar(62)= 'SSSS'  ! SSS, SH 
    540        titvar(63)= 'TsuN'  ! Tsu, NH 
    541        titvar(64)= 'TsuS'  ! Tsu, SH 
    542        titvar(65)= 'TsnN'  ! Tsn, NH 
    543        titvar(66)= 'TsnS'  ! Tsn, SH 
    544        titvar(67)= 'ei_N'  ! ei, NH 
    545        titvar(68)= 'ei_S'  ! ei, SH 
    546        titvar(69)= 'vi1N'  ! vi1, NH 
    547        titvar(70)= 'vi1S'  ! vi1, SH 
    548        titvar(71)= 'vi2N'  ! vi2, NH 
    549        titvar(72)= 'vi2S'  ! vi2, SH 
    550        titvar(73)= 'vi3N'  ! vi3, NH 
    551        titvar(74)= 'vi3S'  ! vi3, SH 
    552        titvar(75)= 'vi4N'  ! vi4, NH 
    553        titvar(76)= 'vi4S'  ! vi4, SH 
    554        titvar(77)= 'vi5N'  ! vi5, NH 
    555        titvar(78)= 'vi5S'  ! vi5, SH 
    556        titvar(79)= 'vi6N'  ! vi6, NH 
    557        titvar(80)= 'vi6S'  ! vi6, SH 
    558        titvar(81)= 'fmaN'  ! mass flux in the ocean, NH 
    559        titvar(82)= 'fmaS'  ! mass flux in the ocean, SH 
    560        titvar(83)= 'AFSE'  ! Fram Strait Area export 
    561        titvar(84)= 'VFSE'  ! Fram Strait Volume export 
    562        nvinfo = 84 
    563  
    564        ! Definition et Ecriture de l'entete : nombre d'enregistrements  
    565        ndeb   = ( nstart - 1 ) / ninfo 
    566        IF( nstart == 1 ) ndeb = -1 
    567  
    568        nferme = ( nstart - 1 + nitrun) / ninfo 
    569        ntot   = nferme - ndeb 
    570        ndeb   = ninfo * ( 1 + ndeb ) 
    571        nferme = ninfo * nferme 
    572  
    573        ! definition of formats  
    574        WRITE( fmtw  , '(A,I3,A2,I1,A)' )  '(', nfrinf, '(A', jpchsep, ','//fmtinf//'))' 
    575        WRITE( fmtr  , '(A,I3,A,I1,A)'  )  '(', nfrinf, '(', jpchsep, 'X,'//fmtinf//'))' 
    576        WRITE( fmtitr, '(A,I3,A,I1,A)'  )  '(', nvinfo, 'A', jpchinf, ')' 
    577  
    578        ! opening  "ice_evolu" file 
    579        clname = 'ice.evolu' 
    580        irecl = ( jpchinf + 1 ) * nvinfo  
    581        CALL ctlopn( numevo_ice, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',    & 
    582           &         irecl, numout, lwp, 1 ) 
    583  
    584        !- ecriture de 2 lignes d''entete : 
    585        WRITE(numevo_ice,1000) fmtr, fmtw, fmtitr, nvinfo, ntot, 0, nfrinf 
    586        zxx0 = 0.001 * REAL(ninfo) 
    587        zxx1 = 0.001 * REAL(ndeb) 
    588        WRITE(numevo_ice,1111) REAL(jpchinf), 0., zxx1, zxx0, 0., 0., 0 
    589  
    590        !- ecriture de 2 lignes de titre : 
    591        WRITE(numevo_ice,'(A,I8,A,I8,A,I5)')                                      & 
    592           'Evolution chronologique - Experience '//cexper   & 
    593           //'   de', ndeb, ' a', nferme, ' pas', ninfo 
    594        WRITE(numevo_ice,fmtitr) ( titvar(jv), jv = 1, nvinfo ) 
    595  
    596  
    597        !--preparation de "titvar" pour l''ecriture parmi les valeurs numeriques : 
    598        DO  jv = 2 , nvinfo 
    599           titinf     = titvar(jv)(:jpchinf) 
    600           titvar(jv) = '  '//titinf 
    601        END DO 
    602  
    603        !--Initialisation of the arrays for the accumulation 
    604        DO  jv = 1, nvinfo 
    605           vinfom(jv) = 0. 
    606        END DO 
    607        naveg = 0 
    608  
    609 1000   FORMAT( 3(A20),4(1x,I6) ) 
    610 1111   FORMAT( 3(F7.1,1X,F7.3,1X),I3,A )   
    611  
    612     END SUBROUTINE lim_dia_init 
     97      INTEGER  ::   jv,ji,jj,jl ! dummy loop indices 
     98      REAL(wp), DIMENSION(jpinfmx) ::  &  
     99         vinfor           ! temporary working space  
     100      REAL(wp) ::    & 
     101         zshift_date   , & ! date from the minimum ice extent 
     102         zday, zday_min, & ! current day, day of minimum extent 
     103         zafy, zamy,     & ! temporary area of fy and my ice 
     104         zindb 
     105      !!------------------------------------------------------------------- 
     106 
     107      ! 0) date from the minimum of ice extent 
     108      !--------------------------------------- 
     109      zday_min = 273.0        ! zday_min = date of minimum extent, here September 30th 
     110      zday = FLOAT(numit-nit000) * rdt_ice / ( 86400.0 * FLOAT(nn_fsbc) ) 
     111      IF (zday.GT.zday_min) THEN  
     112         zshift_date  =  zday - zday_min 
     113      ELSE 
     114         zshift_date  =  zday - (365.0 - zday_min) 
     115      ENDIF 
     116 
     117      IF( numit == nstart )   CALL lim_dia_init   ! initialisation of ice_evolu file       
     118 
     119      ! temporal diagnostics  
     120      vinfor(1) = REAL(numit) 
     121      vinfor(2) = nyear 
     122 
     123      ! put everything to zero 
     124      DO jv = nbvt + 1, nvinfo 
     125         vinfor(jv) = 0.0 
     126      END DO 
     127 
     128      !!------------------------------------------------------------------- 
     129      !! 1) Northern hemisphere 
     130      !!------------------------------------------------------------------- 
     131      !! 1.1) Diagnostics independent on age 
     132      !!------------------------------------ 
     133      DO jj = njeq, jpjm1 
     134         DO ji = fs_2, fs_jpim1   ! vector opt. 
     135            IF( tms(ji,jj) == 1 ) THEN 
     136               vinfor(3)  = vinfor(3)  + at_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice area 
     137               IF (at_i(ji,jj).GT.0.15) vinfor(5) = vinfor(5) + aire(ji,jj) / 1.0e12 !ice extent 
     138               vinfor(7)  = vinfor(7)  + vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice volume 
     139               vinfor(9)  = vinfor(9)  + vt_s(ji,jj)*aire(ji,jj) / 1.0e12 !snow volume 
     140               vinfor(15) = vinfor(15) + ot_i(ji,jj) *vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean age 
     141               vinfor(29) = vinfor(29) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean salinity 
     142               ! the computation of this diagnostic is not reliable 
     143               vinfor(31) = vinfor(31) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
     144                  v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12  
     145               vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) / 1.0e12 !salt flux 
     146               vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) / 1.0e12 !brine drainage flux 
     147               vinfor(57) = vinfor(57) + fseqv(ji,jj)*aire(ji,jj) / 1.0e12 !equivalent salt flux 
     148               vinfor(59) = vinfor(59) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
     149               vinfor(61) = vinfor(61) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
     150               vinfor(65) = vinfor(65) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12  ! snow temperature 
     151               vinfor(67) = vinfor(67) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12       ! ice heat content 
     152               vinfor(69) = vinfor(69) + v_i(ji,jj,1)*aire(ji,jj) / 1.0e12 !ice volume 
     153               vinfor(71) = vinfor(71) + v_i(ji,jj,2)*aire(ji,jj) / 1.0e12 !ice volume 
     154               vinfor(73) = vinfor(73) + v_i(ji,jj,3)*aire(ji,jj) / 1.0e12 !ice volume 
     155               vinfor(75) = vinfor(75) + v_i(ji,jj,4)*aire(ji,jj) / 1.0e12 !ice volume 
     156               vinfor(77) = vinfor(77) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume 
     157               vinfor(79) = 0.0 
     158               vinfor(81) = vinfor(81) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
     159            ENDIF 
     160         END DO 
     161      END DO 
     162 
     163      DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
     164         DO jj = njeq, jpjm1 
     165            DO ji = fs_2, fs_jpim1   ! vector opt. 
     166               IF( tms(ji,jj) == 1 ) THEN 
     167                  vinfor(11) = vinfor(11) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !undef def ice volume 
     168               ENDIF 
     169            END DO 
     170         END DO 
     171      END DO 
     172 
     173      vinfor(13) = 0.0 
     174 
     175      vinfor(15) = vinfor(15) / MAX(vinfor(7),epsi06) ! these have to be divided by total ice volume to have the 
     176      vinfor(29) = vinfor(29) / MAX(vinfor(7),epsi06) ! right value 
     177      vinfor(31) = SQRT( vinfor(31) / MAX( vinfor(7) , epsi06 ) ) 
     178      vinfor(67) = vinfor(67) / MAX(vinfor(7),epsi06) 
     179 
     180      vinfor(53) = vinfor(53) / MAX(vinfor(5),epsi06) ! these have to be divided by total ice extent to have the 
     181      vinfor(55) = vinfor(55) / MAX(vinfor(5),epsi06) ! right value  
     182      vinfor(57) = vinfor(57) / MAX(vinfor(5),epsi06) !  
     183      vinfor(79) = vinfor(79) / MAX(vinfor(5),epsi06) ! 
     184 
     185      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(3))) ! 
     186      vinfor(59) = zindb*vinfor(59) / MAX(vinfor(3),epsi06) ! divide by ice area 
     187      vinfor(61) = zindb*vinfor(61) / MAX(vinfor(3),epsi06) ! 
     188 
     189      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(9))) ! 
     190      vinfor(65) = zindb*vinfor(65) / MAX(vinfor(9),epsi06) ! divide it by snow volume 
     191 
     192 
     193      DO jl = 1, jpl 
     194         DO jj = njeq, jpjm1 
     195            DO ji = fs_2, fs_jpim1   ! vector opt. 
     196               IF( tms(ji,jj) == 1 ) THEN 
     197                  vinfor(33) = vinfor(33) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume 
     198                  vinfor(35) = vinfor(35) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume 
     199               ENDIF 
     200            END DO 
     201         END DO 
     202      END DO 
     203 
     204      DO jj = njeq, jpjm1 
     205         DO ji = fs_2, fs_jpim1   ! vector opt. 
     206            IF( tms(ji,jj) == 1 ) THEN 
     207               vinfor(37) = vinfor(37) + diag_sni_gr(ji,jj)*aire(ji,jj) / 1.0e12 !th growth rates 
     208               vinfor(39) = vinfor(39) + diag_lat_gr(ji,jj)*aire(ji,jj) / 1.0e12  
     209               vinfor(41) = vinfor(41) + diag_bot_gr(ji,jj)*aire(ji,jj) / 1.0e12 
     210               vinfor(43) = vinfor(43) + diag_dyn_gr(ji,jj)*aire(ji,jj) / 1.0e12  
     211               vinfor(45) = vinfor(45) + dv_dt_thd(ji,jj,5)*aire(ji,jj) / 1.0e12 
     212               vinfor(47) = vinfor(47) + v_newice(ji,jj) *aire(ji,jj) / 1.0e12 / rdt_ice ! volume acc in OW 
     213            ENDIF 
     214         END DO 
     215      END DO 
     216 
     217      DO jl = 1, jpl 
     218         DO jj = njeq, jpjm1 
     219            DO ji = fs_2, fs_jpim1   ! vector opt. 
     220               IF( tms(ji,jj) == 1 ) THEN 
     221                  vinfor(63) = vinfor(63) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 
     222               ENDIF 
     223            END DO 
     224         END DO 
     225      END DO 
     226      vinfor(63) = vinfor(63) / MAX(vinfor(3),epsi06) ! these have to be divided by total ice area 
     227 
     228      !! 1.2) Diagnostics dependent on age 
     229      !!------------------------------------ 
     230      DO jj = njeq, jpjm1 
     231         DO ji = fs_2, fs_jpim1   ! vector opt. 
     232            IF( tms(ji,jj) == 1 ) THEN 
     233               zafy = 0.0 
     234               zamy = 0.0 
     235               DO jl = 1, jpl 
     236                  IF ((o_i(ji,jj,jl) - zshift_date).LT.0.0) THEN 
     237                     vinfor(17) = vinfor(17) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice area 
     238                     vinfor(25) = vinfor(25) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice volume 
     239                     vinfor(49) = vinfor(49) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !FY ice salinity 
     240                     zafy = zafy + a_i(ji,jj,jl) 
     241                  ENDIF 
     242                  IF ((o_i(ji,jj,jl) - zshift_date).GT.0.0) THEN 
     243                     vinfor(19) = vinfor(19) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12    ! MY ice area 
     244                     vinfor(27) = vinfor(27) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! MY ice volume 
     245                     vinfor(51) = vinfor(51) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !MY ice salinity 
     246                     zamy = zamy + a_i(ji,jj,jl) 
     247                  ENDIF 
     248               END DO 
     249               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN 
     250                  vinfor(21) = vinfor(21) + aire(ji,jj) / 1.0e12 ! Seasonal ice extent 
     251               ENDIF 
     252               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN 
     253                  vinfor(23) = vinfor(23) + aire(ji,jj) / 1.0e12 ! Perennial ice extent 
     254               ENDIF 
     255            ENDIF 
     256         END DO 
     257      END DO 
     258      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(25))) !=0 if no multiyear ice 1 if yes 
     259      vinfor(49) = zindb*vinfor(49) / MAX(vinfor(25),epsi06) 
     260      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(27))) !=0 if no multiyear ice 1 if yes 
     261      vinfor(51) = zindb*vinfor(51) / MAX(vinfor(27),epsi06) 
     262 
     263      !! Fram Strait Export 
     264      !! 83 = area export 
     265      !! 84 = volume export 
     266      !! Fram strait in ORCA2 = 5 points 
     267      !! export = -v_ice*e1t*ddtb*at_i or -v_ice*e1t*ddtb*at_i*h_i 
     268      jj = 136 ! C grid 
     269      vinfor(83) = 0.0 
     270      vinfor(84) = 0.0 
     271      DO ji = 134, 138 
     272         vinfor(83) = vinfor(83) - v_ice(ji,jj) * &  
     273            e1t(ji,jj)*at_i(ji,jj)*rdt_ice / 1.0e12 
     274         vinfor(84) = vinfor(84) - v_ice(ji,jj) * &  
     275            e1t(ji,jj)*vt_i(ji,jj)*rdt_ice / 1.0e12 
     276      END DO 
     277 
     278      !!------------------------------------------------------------------- 
     279      !! 2) Southern hemisphere 
     280      !!------------------------------------------------------------------- 
     281      !! 2.1) Diagnostics independent on age 
     282      !!------------------------------------ 
     283      DO jj = 2, njeqm1 
     284         DO ji = fs_2, fs_jpim1   ! vector opt. 
     285            IF( tms(ji,jj) == 1 ) THEN 
     286               vinfor(4)  = vinfor(4)  + at_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice area 
     287               IF (at_i(ji,jj).GT.0.15) vinfor(6) = vinfor(6) + aire(ji,jj) / 1.0e12 !ice extent 
     288               vinfor(8)  = vinfor(8)  + vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice volume 
     289               vinfor(10) = vinfor(10) + vt_s(ji,jj)*aire(ji,jj) / 1.0e12 !snow volume 
     290               vinfor(16) = vinfor(16) + ot_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean age 
     291               vinfor(30) = vinfor(30) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean salinity 
     292               ! this diagnostic is not well computed (weighted by vol instead 
     293               ! of area) 
     294               vinfor(32) = vinfor(32) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
     295                  v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 !ice vel 
     296               vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) / 1.0e12 ! Total salt flux 
     297               vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) / 1.0e12 ! Brine drainage salt flux 
     298               vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) / 1.0e12 ! Equivalent salt flux 
     299               vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
     300               vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
     301               vinfor(66) = vinfor(66) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! snow temperature 
     302               vinfor(68) = vinfor(68) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! ice enthalpy 
     303               vinfor(70) = vinfor(70) + v_i(ji,jj,1)*aire(ji,jj) / 1.0e12 !ice volume 
     304               vinfor(72) = vinfor(72) + v_i(ji,jj,2)*aire(ji,jj) / 1.0e12 !ice volume 
     305               vinfor(74) = vinfor(74) + v_i(ji,jj,3)*aire(ji,jj) / 1.0e12 !ice volume 
     306               vinfor(76) = vinfor(76) + v_i(ji,jj,4)*aire(ji,jj) / 1.0e12 !ice volume 
     307               vinfor(78) = vinfor(78) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume 
     308               vinfor(80) = 0.0 
     309               vinfor(82) = vinfor(82) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
     310            ENDIF 
     311         END DO 
     312      END DO 
     313 
     314      DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
     315         DO jj = 2, njeqm1 
     316            DO ji = fs_2, fs_jpim1   ! vector opt. 
     317               vinfor(12) = vinfor(12) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !undef def ice volume 
     318            END DO 
     319         END DO 
     320      END DO 
     321 
     322      vinfor(14) = 0.0 
     323 
     324      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(8)))  
     325      vinfor(16) = zindb * vinfor(16) / MAX(vinfor(8),epsi06) ! these have to be divided by ice vol 
     326      vinfor(30) = zindb * vinfor(30) / MAX(vinfor(8),epsi06) !  
     327      vinfor(32) = zindb * SQRT( vinfor(32) / MAX( vinfor(8) , epsi06 ) ) 
     328      vinfor(68) = zindb * vinfor(68) / MAX(vinfor(8),epsi06) !  
     329 
     330      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(6)))  
     331      vinfor(54) = zindb * vinfor(54) / MAX(vinfor(6),epsi06) ! these have to be divided by ice extt 
     332      vinfor(56) = zindb * vinfor(56) / MAX(vinfor(6),epsi06) !  
     333      vinfor(58) = zindb * vinfor(58) / MAX(vinfor(6),epsi06) !  
     334      vinfor(80) = zindb * vinfor(80) / MAX(vinfor(6),epsi06) ! 
     335      !      vinfor(84) = vinfor(84) / vinfor(6) ! 
     336 
     337      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4))) ! 
     338      vinfor(60) = zindb*vinfor(60) / ( MAX(vinfor(4), epsi06) ) ! divide by ice area 
     339      vinfor(62) = zindb*vinfor(62) / ( MAX(vinfor(4), epsi06) ) ! 
     340 
     341      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(10))) ! 
     342      vinfor(66) = zindb*vinfor(66) / MAX(vinfor(10),epsi06) ! divide it by snow volume 
     343 
     344      DO jl = 1, jpl 
     345         DO jj = 2, njeqm1 
     346            DO ji = fs_2, fs_jpim1   ! vector opt. 
     347               IF( tms(ji,jj) == 1 ) THEN 
     348                  vinfor(34) = vinfor(34) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume 
     349                  vinfor(36) = vinfor(36) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume 
     350               ENDIF 
     351            END DO 
     352         END DO 
     353      END DO 
     354 
     355      DO jj = 2, njeqm1 
     356         DO ji = fs_2, fs_jpim1   ! vector opt. 
     357            IF( tms(ji,jj) == 1 ) THEN 
     358               vinfor(38) = vinfor(38) + diag_sni_gr(ji,jj)*aire(ji,jj) / 1.0e12 !th growth rates 
     359               vinfor(40) = vinfor(40) + diag_lat_gr(ji,jj)*aire(ji,jj) / 1.0e12  
     360               vinfor(42) = vinfor(42) + diag_bot_gr(ji,jj)*aire(ji,jj) / 1.0e12 
     361               vinfor(44) = vinfor(44) + diag_dyn_gr(ji,jj)*aire(ji,jj) / 1.0e12  
     362               vinfor(46) = vinfor(46) + dv_dt_thd(ji,jj,5)*aire(ji,jj) / 1.0e12 
     363               vinfor(48) = vinfor(48) + v_newice(ji,jj) *aire(ji,jj) / 1.0e12 / rdt_ice ! volume acc in OW 
     364            ENDIF 
     365         END DO 
     366      END DO 
     367 
     368 
     369      DO jl = 1, jpl 
     370         DO jj = 2, njeqm1 
     371            DO ji = fs_2, fs_jpim1   ! vector opt. 
     372               IF( tms(ji,jj) == 1 ) THEN 
     373                  vinfor(64) = vinfor(64) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 
     374               ENDIF 
     375            END DO 
     376         END DO 
     377      END DO 
     378      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4))) ! 
     379      vinfor(64) = zindb * vinfor(64) / MAX(vinfor(4),epsi06) ! divide by ice extt 
     380      !! 2.2) Diagnostics dependent on age 
     381      !!------------------------------------ 
     382      DO jj = 2, njeqm1 
     383         DO ji = fs_2, fs_jpim1   ! vector opt. 
     384            IF( tms(ji,jj) == 1 ) THEN 
     385               zafy = 0.0 
     386               zamy = 0.0 
     387               DO jl = 1, jpl 
     388                  IF ((o_i(ji,jj,jl) - zshift_date).LT.0.0) THEN 
     389                     vinfor(18) = vinfor(18) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice area 
     390                     vinfor(26) = vinfor(26) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice volume 
     391                     zafy = zafy + a_i(ji,jj,jl) 
     392                     vinfor(50) = vinfor(50) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !FY ice salinity 
     393                  ENDIF 
     394                  IF ((o_i(ji,jj,jl) - zshift_date).GT.0.0) THEN 
     395                     vinfor(20) = vinfor(20) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12    ! MY ice area 
     396                     vinfor(28) = vinfor(28) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 
     397                     vinfor(52) = vinfor(52) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !FY ice salinity 
     398                     zamy = zamy + a_i(ji,jj,jl) 
     399                  ENDIF 
     400               END DO ! jl 
     401               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN 
     402                  vinfor(22) = vinfor(22) + aire(ji,jj) / 1.0e12 ! Seasonal ice extent 
     403               ENDIF 
     404               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN 
     405                  vinfor(24) = vinfor(24) + aire(ji,jj) / 1.0e12 ! Perennial ice extent 
     406               ENDIF 
     407            ENDIF ! tms 
     408         END DO ! jj 
     409      END DO ! ji 
     410      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(26))) !=0 if no multiyear ice 1 if yes 
     411      vinfor(50) = zindb*vinfor(50) / MAX(vinfor(26),epsi06) 
     412      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(28))) !=0 if no multiyear ice 1 if yes 
     413      vinfor(52) = zindb*vinfor(52) / MAX(vinfor(28),epsi06) 
     414 
     415      !  Accumulation before averaging  
     416      DO jv = 1, nvinfo 
     417         vinfom(jv) = vinfom(jv) + vinfor(jv) 
     418      END DO 
     419      naveg = naveg + 1   
     420 
     421      ! oututs on file ice_evolu     
     422      !MV      IF( MOD( numit , ninfo ) == 0 ) THEN 
     423      WRITE(numevo_ice,fmtw) ( titvar(jv), vinfom(jv)/naveg, jv = 1, nvinfo ) 
     424      naveg = 0 
     425      DO jv = 1, nvinfo 
     426         vinfom(jv)=0.0 
     427      END DO 
     428      !MV      ENDIF 
     429 
     430   END SUBROUTINE lim_dia 
     431 
     432   SUBROUTINE lim_dia_init 
     433      !!------------------------------------------------------------------- 
     434      !!                  ***  ROUTINE lim_dia_init  *** 
     435      !!              
     436      !! ** Purpose : Preparation of the file ice_evolu for the output of 
     437      !!      the temporal evolution of key variables 
     438      !! 
     439      !! ** input   : Namelist namicedia 
     440      !! 
     441      !! history : 
     442      !!  8.5  ! 03-08 (C. Ethe) original code 
     443      !!  9.0  ! 08-03 (M. Vancoppenolle) LIM3 
     444      !!------------------------------------------------------------------- 
     445      NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy 
     446 
     447      INTEGER  ::   jv   ,     &  ! dummy loop indice 
     448         &          ntot ,     & 
     449         &          ndeb ,     & 
     450         &          irecl 
     451 
     452      REAL(wp) ::   zxx0, zxx1    ! temporary scalars 
     453 
     454      CHARACTER(len=jpchinf) ::   titinf 
     455      CHARACTER(len=50)      ::   clname 
     456      !!------------------------------------------------------------------- 
     457 
     458 
     459      ! Read Namelist namicedia 
     460      REWIND ( numnam_ice ) 
     461      READ   ( numnam_ice  , namicedia ) 
     462      IF(lwp) THEN 
     463         WRITE(numout,*) 
     464         WRITE(numout,*) 'lim_dia_init : ice parameters for ice diagnostics ' 
     465         WRITE(numout,*) '~~~~~~~~~~~~' 
     466         WRITE(numout,*) '   format of the output values                                 fmtinf = ', fmtinf 
     467         WRITE(numout,*) '   number of variables written in one line                     nfrinf = ', nfrinf  
     468         WRITE(numout,*) '   Instantaneous values of ice evolution or averaging          ntmoy  = ', ntmoy 
     469         WRITE(numout,*) '   frequency of ouputs on file ice_evolu in case of averaging  ninfo  = ', ninfo 
     470      ENDIF 
     471 
     472      ! masked grid cell area 
     473      aire(:,:) = area(:,:) * tms(:,:) 
     474 
     475      ! Titles of ice key variables : 
     476      titvar(1) = 'NoIt'  ! iteration number 
     477      titvar(2) = 'T yr'  ! time step in years 
     478      nbvt = 2            ! number of time variables 
     479 
     480      titvar(3) = 'AI_N'  ! sea ice area in the northern Hemisp.(10^12 km2) 
     481      titvar(4) = 'AI_S'  ! sea ice area in the southern Hemisp.(10^12 km2) 
     482      titvar(5) = 'EI_N'  ! sea ice extent (15%) in the northern Hemisp.(10^12 km2) 
     483      titvar(6) = 'EI_S'  ! sea ice extent (15%) in the southern Hemisp.(10^12 km2) 
     484      titvar(7) = 'VI_N'  ! sea ice volume in the northern Hemisp.(10^3 km3) 
     485      titvar(8) = 'VI_S'  ! sea ice volume in the southern Hemisp.(10^3 km3) 
     486      titvar(9) = 'VS_N'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3) 
     487      titvar(10)= 'VS_S'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3) 
     488      titvar(11)= 'VuIN'  ! undeformed sea ice volume in the northern Hemisp.(10^3 km3) 
     489      titvar(12)= 'VuIS'  ! undeformed sea ice volume in the southern Hemisp.(10^3 km3) 
     490      titvar(13)= 'VdIN'  ! deformed sea ice volume in the northern Hemisp.(10^3 km3) 
     491      titvar(14)= 'VdIS'  ! deformed sea ice volume in the southern Hemisp.(10^3 km3) 
     492      titvar(15)= 'OI_N'  ! sea ice mean age in the northern Hemisp.(years) 
     493      titvar(16)= 'OI_S'  ! sea ice mean age in the southern Hemisp.(years) 
     494      titvar(17)= 'AFYN'  ! total FY ice area northern Hemisp.(10^12 km2) 
     495      titvar(18)= 'AFYS'  ! total FY ice area southern Hemisp.(10^12 km2) 
     496      titvar(19)= 'AMYN'  ! total MY ice area northern Hemisp.(10^12 km2) 
     497      titvar(20)= 'AMYS'  ! total MY ice area southern Hemisp.(10^12 km2) 
     498      titvar(21)= 'EFYN'  ! total FY ice extent northern Hemisp.(10^12 km2) (with more 50% FY ice) 
     499      titvar(22)= 'EFYS'  ! total FY ice extent southern Hemisp.(10^12 km2) (with more 50% FY ice) 
     500      titvar(23)= 'EMYN'  ! total MY ice extent northern Hemisp.(10^12 km2) (with more 50% MY ice) 
     501      titvar(24)= 'EMYS'  ! total MY ice extent southern Hemisp.(10^12 km2) (with more 50% MY ice) 
     502      titvar(25)= 'VFYN'  ! total undeformed FY ice volume northern Hemisp.(10^3 km3)  
     503      titvar(26)= 'VFYS'  ! total undeformed FY ice volume southern Hemisp.(10^3 km3) 
     504      titvar(27)= 'VMYN'  ! total undeformed MY ice volume northern Hemisp.(10^3 km3)  
     505      titvar(28)= 'VMYS'  ! total undeformed MY ice volume southern Hemisp.(10^3 km3)  
     506      titvar(29)= 'IS_N'  ! sea ice mean salinity in the northern hemisphere (ppt)   
     507      titvar(30)= 'IS_S'  ! sea ice mean salinity in the southern hemisphere (ppt)   
     508      titvar(31)= 'IVeN'  ! sea ice mean velocity in the northern hemisphere (m/s)  
     509      titvar(32)= 'IVeS'  ! sea ice mean velocity in the southern hemisphere (m/s)  
     510      titvar(33)= 'DVDN'  ! variation of sea ice volume due to dynamics in the northern hemisphere 
     511      titvar(34)= 'DVDS'  ! variation of sea ice volume due to dynamics in the southern hemisphere 
     512      titvar(35)= 'DVTN'  ! variation of sea ice volume due to thermo in the   northern hemisphere 
     513      titvar(36)= 'DVTS'  ! variation of sea ice volume due to thermo in the   southern hemisphere 
     514      titvar(37)= 'TG1N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 1   
     515      titvar(38)= 'TG1S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 1   
     516      titvar(39)= 'TG2N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 2   
     517      titvar(40)= 'TG2S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 2   
     518      titvar(41)= 'TG3N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 3   
     519      titvar(42)= 'TG3S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 3   
     520      titvar(43)= 'TG4N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 4   
     521      titvar(44)= 'TG4S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 4   
     522      titvar(45)= 'TG5N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 5   
     523      titvar(46)= 'TG5S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 5   
     524      titvar(47)= 'LA_N'  ! lateral accretion growth rate, northern hemisphere 
     525      titvar(48)= 'LA_S'  ! lateral accretion growth rate, southern hemisphere  
     526      titvar(49)= 'SF_N'  ! Salinity FY, NH  
     527      titvar(50)= 'SF_S'  ! Salinity FY, SH  
     528      titvar(51)= 'SF_N'  ! Salinity MY, NH  
     529      titvar(52)= 'SF_S'  ! Salinity MY, SH  
     530      titvar(53)= 'Fs_N'  ! Total salt flux NH 
     531      titvar(54)= 'Fs_S'  ! Total salt flux SH 
     532      titvar(55)= 'FsbN'  ! Salt - brine drainage flux NH 
     533      titvar(56)= 'FsbS'  ! Salt - brine drainage flux SH 
     534      titvar(57)= 'FseN'  ! Salt - Equivalent salt flux NH 
     535      titvar(58)= 'FseS'  ! Salt - Equivalent salt flux SH 
     536      titvar(59)= 'SSTN'  ! SST, NH 
     537      titvar(60)= 'SSTS'  ! SST, SH 
     538      titvar(61)= 'SSSN'  ! SSS, NH 
     539      titvar(62)= 'SSSS'  ! SSS, SH 
     540      titvar(63)= 'TsuN'  ! Tsu, NH 
     541      titvar(64)= 'TsuS'  ! Tsu, SH 
     542      titvar(65)= 'TsnN'  ! Tsn, NH 
     543      titvar(66)= 'TsnS'  ! Tsn, SH 
     544      titvar(67)= 'ei_N'  ! ei, NH 
     545      titvar(68)= 'ei_S'  ! ei, SH 
     546      titvar(69)= 'vi1N'  ! vi1, NH 
     547      titvar(70)= 'vi1S'  ! vi1, SH 
     548      titvar(71)= 'vi2N'  ! vi2, NH 
     549      titvar(72)= 'vi2S'  ! vi2, SH 
     550      titvar(73)= 'vi3N'  ! vi3, NH 
     551      titvar(74)= 'vi3S'  ! vi3, SH 
     552      titvar(75)= 'vi4N'  ! vi4, NH 
     553      titvar(76)= 'vi4S'  ! vi4, SH 
     554      titvar(77)= 'vi5N'  ! vi5, NH 
     555      titvar(78)= 'vi5S'  ! vi5, SH 
     556      titvar(79)= 'vi6N'  ! vi6, NH 
     557      titvar(80)= 'vi6S'  ! vi6, SH 
     558      titvar(81)= 'fmaN'  ! mass flux in the ocean, NH 
     559      titvar(82)= 'fmaS'  ! mass flux in the ocean, SH 
     560      titvar(83)= 'AFSE'  ! Fram Strait Area export 
     561      titvar(84)= 'VFSE'  ! Fram Strait Volume export 
     562      nvinfo = 84 
     563 
     564      ! Definition et Ecriture de l'entete : nombre d'enregistrements  
     565      ndeb   = ( nstart - 1 ) / ninfo 
     566      IF( nstart == 1 ) ndeb = -1 
     567 
     568      nferme = ( nstart - 1 + nitrun) / ninfo 
     569      ntot   = nferme - ndeb 
     570      ndeb   = ninfo * ( 1 + ndeb ) 
     571      nferme = ninfo * nferme 
     572 
     573      ! definition of formats  
     574      WRITE( fmtw  , '(A,I3,A2,I1,A)' )  '(', nfrinf, '(A', jpchsep, ','//fmtinf//'))' 
     575      WRITE( fmtr  , '(A,I3,A,I1,A)'  )  '(', nfrinf, '(', jpchsep, 'X,'//fmtinf//'))' 
     576      WRITE( fmtitr, '(A,I3,A,I1,A)'  )  '(', nvinfo, 'A', jpchinf, ')' 
     577 
     578      ! opening  "ice_evolu" file 
     579      clname = 'ice.evolu' 
     580      irecl = ( jpchinf + 1 ) * nvinfo  
     581      CALL ctlopn( numevo_ice, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',    & 
     582         &         irecl, numout, lwp, 1 ) 
     583 
     584      !- ecriture de 2 lignes d''entete : 
     585      WRITE(numevo_ice,1000) fmtr, fmtw, fmtitr, nvinfo, ntot, 0, nfrinf 
     586      zxx0 = 0.001 * REAL(ninfo) 
     587      zxx1 = 0.001 * REAL(ndeb) 
     588      WRITE(numevo_ice,1111) REAL(jpchinf), 0., zxx1, zxx0, 0., 0., 0 
     589 
     590      !- ecriture de 2 lignes de titre : 
     591      WRITE(numevo_ice,'(A,I8,A,I8,A,I5)')                                      & 
     592         'Evolution chronologique - Experience '//cexper   & 
     593         //'   de', ndeb, ' a', nferme, ' pas', ninfo 
     594      WRITE(numevo_ice,fmtitr) ( titvar(jv), jv = 1, nvinfo ) 
     595 
     596 
     597      !--preparation de "titvar" pour l''ecriture parmi les valeurs numeriques : 
     598      DO  jv = 2 , nvinfo 
     599         titinf     = titvar(jv)(:jpchinf) 
     600         titvar(jv) = '  '//titinf 
     601      END DO 
     602 
     603      !--Initialisation of the arrays for the accumulation 
     604      DO  jv = 1, nvinfo 
     605         vinfom(jv) = 0. 
     606      END DO 
     607      naveg = 0 
     608 
     6091000  FORMAT( 3(A20),4(1x,I6) ) 
     6101111  FORMAT( 3(F7.1,1X,F7.3,1X),I3,A )   
     611 
     612   END SUBROUTINE lim_dia_init 
    613613 
    614614#else 

  • trunk/NEMO/LIM_SRC_3/limdyn.F90

    r913 r921  
    4848CONTAINS 
    4949 
    50    SUBROUTINE lim_dyn 
     50   SUBROUTINE lim_dyn( kt ) 
    5151      !!------------------------------------------------------------------- 
    5252      !!               ***  ROUTINE lim_dyn  *** 
    … …  
    6666      !!                   LIM3, EVP, C-grid 
    6767      !!------------------------------------------------------------------------------------ 
     68      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    6869      !! * Local variables 
    6970      INTEGER  ::   ji, jj, jl, ja    ! dummy loop indices 
    … …  
    7576      !!--------------------------------------------------------------------- 
    7677 
    77       WRITE(numout,*) ' lim_dyn : Ice dynamics ' 
    78       WRITE(numout,*) ' ~~~~~~~ ' 
     78      IF( kt == nit000 .AND. lwp ) THEN 
     79         WRITE(numout,*) ' lim_dyn : Ice dynamics ' 
     80         WRITE(numout,*) ' ~~~~~~~ ' 
     81      ENDIF 
    7982 
    8083      IF( numit == nstart  )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    81        
     84 
    8285      IF ( ln_limdyn ) THEN 
    8386 
    … …  
    219222   END SUBROUTINE lim_dyn 
    220223 
    221     SUBROUTINE lim_dyn_init 
     224   SUBROUTINE lim_dyn_init 
    222225      !!------------------------------------------------------------------- 
    223226      !!                  ***  ROUTINE lim_dyn_init  *** 

  • trunk/NEMO/LIM_SRC_3/limhdf.F90

    r888 r921  
    8484      ! Arrays initialization 
    8585      ptab0 (:, : ) = ptab(:,:) 
    86 !bug  zflu (:,jpj) = 0.e0 
    87 !bug  zflv (:,jpj) = 0.e0 
     86      !bug  zflu (:,jpj) = 0.e0 
     87      !bug  zflv (:,jpj) = 0.e0 
    8888      zdiv0(:, 1 ) = 0.e0 
    8989      zdiv0(:,jpj) = 0.e0 

  • trunk/NEMO/LIM_SRC_3/limistate.F90

    r888 r921  
    8686         zvol, zare, zh, zh1, zh2, zh3, zan, zbn, zas, zbs  
    8787      !-------------------------------------------------------------------- 
    88   
     88 
    8989      !-------------------------------------------------------------------- 
    9090      ! 1) Preliminary things  
    … …  
    113113      zs0 = 34.e0 
    114114      ztf = ABS ( rt0 - 0.0575       * zs0                               & 
    115                &                    + 1.710523e-03 * zs0 * SQRT( zs0 )   & 
    116                &                    - 2.154996e-04 * zs0 *zs0          ) 
     115         &                    + 1.710523e-03 * zs0 * SQRT( zs0 )   & 
     116         &                    - 2.154996e-04 * zs0 *zs0          ) 
    117117 
    118118      ! constants for heat contents 
    … …  
    179179      ! ------------- 
    180180!!! 
    181 ! retour a LIMA_MEC 
    182 !     ! second ice type 
    183 !     zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
    184 !     hi_max(ice_cat_bounds(2,1)-1) = 0.0 
    185  
    186 !     ! here to change !!!! 
    187 !     jm = 2 
    188 !     DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    189 !        zhin (2)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    190 !        zhin (2)     = ( hi_max_typ(jl-ice_cat_bounds(2,1),jm    ) + & 
    191 !                         hi_max_typ(jl-ice_cat_bounds(2,1) + 1,jm)   ) / 2.0 
    192 !        zgfactorn(2) = zgfactorn(2) + exp(-(zhin(2)-hginn_d)*(zhin(2)-hginn_d)/2.0) 
    193 !        zhis (2)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    194 !        zhis (2)     = ( hi_max_typ(jl-ice_cat_bounds(2,1),jm    ) + & 
    195 !                         hi_max_typ(jl-ice_cat_bounds(2,1) + 1,jm)   ) / 2.0 
    196 !        zgfactors(2) = zgfactors(2) + exp(-(zhis(2)-hgins_d)*(zhis(2)-hgins_d)/2.0) 
    197 !     END DO ! jl 
    198 !     zgfactorn(2) = aginn_d / zgfactorn(2) 
    199 !     zgfactors(2) = agins_d / zgfactors(2) 
    200 !     hi_max(ice_cat_bounds(2,1)-1) = zdummy 
    201 ! END retour a LIMA_MEC 
     181      ! retour a LIMA_MEC 
     182      !     ! second ice type 
     183      !     zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
     184      !     hi_max(ice_cat_bounds(2,1)-1) = 0.0 
     185 
     186      !     ! here to change !!!! 
     187      !     jm = 2 
     188      !     DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     189      !        zhin (2)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
     190      !        zhin (2)     = ( hi_max_typ(jl-ice_cat_bounds(2,1),jm    ) + & 
     191      !                         hi_max_typ(jl-ice_cat_bounds(2,1) + 1,jm)   ) / 2.0 
     192      !        zgfactorn(2) = zgfactorn(2) + exp(-(zhin(2)-hginn_d)*(zhin(2)-hginn_d)/2.0) 
     193      !        zhis (2)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
     194      !        zhis (2)     = ( hi_max_typ(jl-ice_cat_bounds(2,1),jm    ) + & 
     195      !                         hi_max_typ(jl-ice_cat_bounds(2,1) + 1,jm)   ) / 2.0 
     196      !        zgfactors(2) = zgfactors(2) + exp(-(zhis(2)-hgins_d)*(zhis(2)-hgins_d)/2.0) 
     197      !     END DO ! jl 
     198      !     zgfactorn(2) = aginn_d / zgfactorn(2) 
     199      !     zgfactors(2) = agins_d / zgfactors(2) 
     200      !     hi_max(ice_cat_bounds(2,1)-1) = zdummy 
     201      ! END retour a LIMA_MEC 
    202202!!! 
    203203      DO jj = 1, jpj 
    … …  
    228228                     zhin(1)          = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    229229                     a_i(ji,jj,jl)    = zidto * MAX( zgfactorn(1) * exp(-(zhin(1)-hginn_u)* &  
    230                                             (zhin(1)-hginn_u)/2.0) , epsi06) 
     230                        (zhin(1)-hginn_u)/2.0) , epsi06) 
    231231                     ! new line 
    232232                     a_i(ji,jj,jl)    = zidto * ( zan * zhin(1) * zhin(1) + zbn * zhin(1) ) 
    … …  
    239239 
    240240!!! 
    241 ! retour a LIMA_MEC 
    242 !              !ridged ice 
    243 !              zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
    244 !              hi_max(ice_cat_bounds(2,1)-1) = 0.0 
    245 !              DO jl = ice_cat_bounds(2,1), ice_cat_bounds(2,2) ! loop over ice thickness categories 
    246 !                 zhin(2)          = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    247 !                 a_i(ji,jj,jl)    = zidto * MAX( zgfactorn(2) * exp(-(zhin(2)-hginn_d)* & 
    248 !                                    (zhin(2)-hginn_d)/2.0) , epsi06) 
    249 !                 ht_i(ji,jj,jl)   = zidto * zhin(2)  
    250 !                 v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    251 !              END DO 
    252 !              hi_max(ice_cat_bounds(2,1)-1) = zdummy 
    253  
    254 !              !rafted ice 
    255 !              jl = 6 
    256 !              a_i(ji,jj,jl)       = 0.0 
    257 !              ht_i(ji,jj,jl)      = 0.0 
    258 !              v_i(ji,jj,jl)       = 0.0 
    259 ! END retour a LIMA_MEC 
     241               ! retour a LIMA_MEC 
     242               !              !ridged ice 
     243               !              zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
     244               !              hi_max(ice_cat_bounds(2,1)-1) = 0.0 
     245               !              DO jl = ice_cat_bounds(2,1), ice_cat_bounds(2,2) ! loop over ice thickness categories 
     246               !                 zhin(2)          = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
     247               !                 a_i(ji,jj,jl)    = zidto * MAX( zgfactorn(2) * exp(-(zhin(2)-hginn_d)* & 
     248               !                                    (zhin(2)-hginn_d)/2.0) , epsi06) 
     249               !                 ht_i(ji,jj,jl)   = zidto * zhin(2)  
     250               !                 v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
     251               !              END DO 
     252               !              hi_max(ice_cat_bounds(2,1)-1) = zdummy 
     253 
     254               !              !rafted ice 
     255               !              jl = 6 
     256               !              a_i(ji,jj,jl)       = 0.0 
     257               !              ht_i(ji,jj,jl)      = 0.0 
     258               !              v_i(ji,jj,jl)       = 0.0 
     259               ! END retour a LIMA_MEC 
    260260!!! 
    261261 
    … …  
    279279                  o_i(ji,jj,jl)    = zidto * 1.0   + ( 1.0 - zidto ) 
    280280                  oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl) 
    281                       
     281 
    282282                  !------------------------------ 
    283283                  ! Sea ice surface temperature 
    … …  
    298298                     ! Multiply by volume, so that heat content in 10^9 Joules 
    299299                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * & 
    300                                         v_s(ji,jj,jl)  / nlay_s 
     300                        v_s(ji,jj,jl)  / nlay_s 
    301301                  END DO !jk 
    302302 
    … …  
    309309                     s_i(ji,jj,jk,jl) = zidto * sinn + ( 1.0 - zidto ) * 0.1 
    310310                     ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
    311   
    312                   ! heat content per unit volume 
     311 
     312                     ! heat content per unit volume 
    313313                     e_i(ji,jj,jk,jl) = zidto * rhoic * & 
    314                      (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    315                      +   lfus    * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-zeps) ) & 
    316                      - rcp      * ( ztmelts - rtt ) & 
    317                      ) 
    318  
    319                   ! Correct dimensions to avoid big values 
     314                        (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
     315                        +   lfus    * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-zeps) ) & 
     316                        - rcp      * ( ztmelts - rtt ) & 
     317                        ) 
     318 
     319                     ! Correct dimensions to avoid big values 
    320320                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    321321 
    322                   ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
     322                     ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    323323                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * &  
    324                                   area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / & 
    325                                   nlay_i 
     324                        area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / & 
     325                        nlay_i 
    326326                  END DO ! jk 
    327327 
    … …  
    330330            ELSE ! on fcor  
    331331 
    332             !--- Southern hemisphere 
    333             !---------------------------------------------------------------- 
     332               !--- Southern hemisphere 
     333               !---------------------------------------------------------------- 
    334334 
    335335               !----------------------- 
    … …  
    346346 
    347347               ELSE ! several categories 
    348                 
    349                !level ice 
     348 
     349                  !level ice 
    350350                  DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) !over thickness categories 
    351351 
    352352                     zhis(1)       = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    353353                     a_i(ji,jj,jl) = zidto * MAX( zgfactors(1) * exp(-(zhis(1)-hgins_u) * &  
    354                                         (zhis(1)-hgins_u)/2.0) , epsi06 ) 
     354                        (zhis(1)-hgins_u)/2.0) , epsi06 ) 
    355355                     ! new line square distribution volume conserving 
    356356                     a_i(ji,jj,jl)    = zidto * ( zas * zhis(1) * zhis(1) + zbs * zhis(1) ) 
    357357                     ht_i(ji,jj,jl)   = zidto * zhis(1)  
    358358                     v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    359                    
     359 
    360360                  END DO ! jl 
    361361 
    … …  
    363363 
    364364!!! 
    365 ! retour a LIMA_MEC 
    366 !              !ridged ice 
    367 !              zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
    368 !              hi_max(ice_cat_bounds(2,1)-1) = 0.0 
    369 !              DO jl = ice_cat_bounds(2,1), ice_cat_bounds(2,2) !over thickness categories 
    370 !                 zhis(2)       = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    371 !                 a_i(ji,jj,jl) = zidto*MAX( zgfactors(2) * exp(-(zhis(2)-hgins_d)*(zhis(2)-hgins_d)/2.0), epsi06 ) 
    372 !                 ht_i(ji,jj,jl)   = zidto * zhis(2)  
    373 !                 v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    374 !              END DO 
    375 !              hi_max(ice_cat_bounds(2,1)-1) = zdummy 
    376  
    377 !              !rafted ice 
    378 !              jl = 6 
    379 !              a_i(ji,jj,jl)       = 0.0 
    380 !              ht_i(ji,jj,jl)      = 0.0 
    381 !              v_i(ji,jj,jl)       = 0.0 
    382 ! END retour a LIMA_MEC 
     365               ! retour a LIMA_MEC 
     366               !              !ridged ice 
     367               !              zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
     368               !              hi_max(ice_cat_bounds(2,1)-1) = 0.0 
     369               !              DO jl = ice_cat_bounds(2,1), ice_cat_bounds(2,2) !over thickness categories 
     370               !                 zhis(2)       = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
     371               !                 a_i(ji,jj,jl) = zidto*MAX( zgfactors(2) * exp(-(zhis(2)-hgins_d)*(zhis(2)-hgins_d)/2.0), epsi06 ) 
     372               !                 ht_i(ji,jj,jl)   = zidto * zhis(2)  
     373               !                 v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
     374               !              END DO 
     375               !              hi_max(ice_cat_bounds(2,1)-1) = zdummy 
     376 
     377               !              !rafted ice 
     378               !              jl = 6 
     379               !              a_i(ji,jj,jl)       = 0.0 
     380               !              ht_i(ji,jj,jl)      = 0.0 
     381               !              v_i(ji,jj,jl)       = 0.0 
     382               ! END retour a LIMA_MEC 
    383383!!! 
    384384 
    … …  
    424424                     ! Multiply by volume, so that heat content in 10^9 Joules 
    425425                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * & 
    426                                         v_s(ji,jj,jl)  / nlay_s 
     426                        v_s(ji,jj,jl)  / nlay_s 
    427427                  END DO 
    428428 
    … …  
    435435                     s_i(ji,jj,jk,jl) = zidto * sins + ( 1.0 - zidto ) * 0.1 
    436436                     ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
    437   
    438                   ! heat content per unit volume 
     437 
     438                     ! heat content per unit volume 
    439439                     e_i(ji,jj,jk,jl) = zidto * rhoic * & 
    440                      (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    441                      +   lfus  * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-zeps) ) & 
    442                      - rcp      * ( ztmelts - rtt ) & 
    443                      ) 
    444  
    445                   ! Correct dimensions to avoid big values 
     440                        (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
     441                        +   lfus  * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-zeps) ) & 
     442                        - rcp      * ( ztmelts - rtt ) & 
     443                        ) 
     444 
     445                     ! Correct dimensions to avoid big values 
    446446                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    447447 
    448                   ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
     448                     ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    449449                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * &  
    450                                      area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / & 
    451                                      nlay_i 
     450                        area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / & 
     451                        nlay_i 
    452452                  END DO !jk 
    453453 
    … …  
    549549      !!----------------------------------------------------------------------------- 
    550550      NAMELIST/namiceini/ ttest, hninn, hginn_u, aginn_u, hginn_d, aginn_d, hnins, & 
    551                           hgins_u, agins_u, hgins_d, agins_d, sinn, sins 
     551         hgins_u, agins_u, hgins_d, agins_d, sinn, sins 
    552552      !!----------------------------------------------------------------------------- 
    553553 
    … …  
    576576         WRITE(numout,*) '   initial  ice salinity       in the south     sins       = ', sins 
    577577      ENDIF 
    578              
     578 
    579579   END SUBROUTINE lim_istate_init 
    580580 

  • trunk/NEMO/LIM_SRC_3/limitd_me.F90

    r903 r921  
    3232   USE prtctl           ! Print control 
    3333   USE lib_mpp 
    34   
     34 
    3535   IMPLICIT NONE 
    3636   PRIVATE 
    … …  
    5353      zone   = 1.e0 
    5454 
    55 !----------------------------------------------------------------------- 
    56 ! Variables shared among ridging subroutines 
    57 !----------------------------------------------------------------------- 
    58       REAL(wp), DIMENSION (jpi,jpj) ::    & 
    59          asum         , & ! sum of total ice and open water area 
    60          aksum            ! ratio of area removed to area ridged 
    61  
    62       REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: &      
    63          athorn           ! participation function; fraction of ridging/ 
    64                           !  closing associated w/ category n 
    65  
    66       REAL(wp), DIMENSION(jpi,jpj,jpl) ::  & 
    67          hrmin      , &   ! minimum ridge thickness 
    68          hrmax      , &   ! maximum ridge thickness 
    69          hraft      , &   ! thickness of rafted ice 
    70          krdg       , &   ! mean ridge thickness/thickness of ridging ice  
    71          aridge     , &   ! participating ice ridging 
    72          araft            ! participating ice rafting 
    73  
    74       REAL(wp), PARAMETER :: & 
    75          krdgmin = 1.1, &    ! min ridge thickness multiplier 
    76          kraft   = 2.0       ! rafting multipliyer 
    77  
    78       REAL(wp) :: &                                
    79          Cp  
    80 ! 
    81 !----------------------------------------------------------------------- 
    82 ! Ridging diagnostic arrays for history files 
    83 !----------------------------------------------------------------------- 
    84 ! 
    85       REAL (wp), DIMENSION(jpi,jpj) :: & 
    86          dardg1dt     , & ! rate of fractional area loss by ridging ice (1/s) 
    87          dardg2dt     , & ! rate of fractional area gain by new ridges (1/s) 
    88          dvirdgdt     , & ! rate of ice volume ridged (m/s) 
    89          opening          ! rate of opening due to divergence/shear (1/s) 
    90                                         
     55   !----------------------------------------------------------------------- 
     56   ! Variables shared among ridging subroutines 
     57   !----------------------------------------------------------------------- 
     58   REAL(wp), DIMENSION (jpi,jpj) ::    & 
     59      asum         , & ! sum of total ice and open water area 
     60      aksum            ! ratio of area removed to area ridged 
     61 
     62   REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: &      
     63      athorn           ! participation function; fraction of ridging/ 
     64   !  closing associated w/ category n 
     65 
     66   REAL(wp), DIMENSION(jpi,jpj,jpl) ::  & 
     67      hrmin      , &   ! minimum ridge thickness 
     68      hrmax      , &   ! maximum ridge thickness 
     69      hraft      , &   ! thickness of rafted ice 
     70      krdg       , &   ! mean ridge thickness/thickness of ridging ice  
     71      aridge     , &   ! participating ice ridging 
     72      araft            ! participating ice rafting 
     73 
     74   REAL(wp), PARAMETER :: & 
     75      krdgmin = 1.1, &    ! min ridge thickness multiplier 
     76      kraft   = 2.0       ! rafting multipliyer 
     77 
     78   REAL(wp) :: &                                
     79      Cp  
     80   ! 
     81   !----------------------------------------------------------------------- 
     82   ! Ridging diagnostic arrays for history files 
     83   !----------------------------------------------------------------------- 
     84   ! 
     85   REAL (wp), DIMENSION(jpi,jpj) :: & 
     86      dardg1dt     , & ! rate of fractional area loss by ridging ice (1/s) 
     87      dardg2dt     , & ! rate of fractional area gain by new ridges (1/s) 
     88      dvirdgdt     , & ! rate of ice volume ridged (m/s) 
     89      opening          ! rate of opening due to divergence/shear (1/s) 
     90 
    9191 
    9292   !!---------------------------------------------------------------------- 
    … …  
    9797CONTAINS 
    9898 
    99 !!-----------------------------------------------------------------------------! 
    100 !!-----------------------------------------------------------------------------! 
     99   !!-----------------------------------------------------------------------------! 
     100   !!-----------------------------------------------------------------------------! 
    101101 
    102102   SUBROUTINE lim_itd_me ! (subroutine 1/6) 
    103         !!---------------------------------------------------------------------! 
    104         !!                ***  ROUTINE lim_itd_me *** 
    105         !! ** Purpose : 
    106         !!        This routine computes the mechanical redistribution 
    107         !!                      of ice thickness 
    108         !! 
    109         !! ** Method  : a very simple method :-) 
    110         !! 
    111         !! ** Arguments : 
    112         !!           kideb , kiut : Starting and ending points on which the  
    113         !!                         the computation is applied 
    114         !! 
    115         !! ** Inputs / Ouputs : (global commons) 
    116         !! 
    117         !! ** External :  
    118         !! 
    119         !! ** Steps : 
    120         !!  1) Thickness categories boundaries, ice / o.w. concentrations 
    121         !!     Ridge preparation 
    122         !!  2) Dynamical inputs (closing rate, divu_adv, opning) 
    123         !!  3) Ridging iteration 
    124         !!  4) Ridging diagnostics 
    125         !!  5) Heat, salt and freshwater fluxes 
    126         !!  6) Compute increments of tate variables and come back to old values 
    127         !! 
    128         !! ** References : There are a lot of references and can be difficult /  
    129         !!                 boring to read 
    130         !! 
    131         !! Flato, G. M., and W. D. Hibler III, 1995: Ridging and strength 
    132         !!  in modeling the thickness distribution of Arctic sea ice, 
    133         !!  J. Geophys. Res., 100, 18,611-18,626. 
    134         !! 
    135         !! Hibler, W. D. III, 1980: Modeling a variable thickness sea ice 
    136         !!  cover, Mon. Wea. Rev., 108, 1943-1973, 1980. 
    137         !! 
    138         !! Rothrock, D. A., 1975: The energetics of the plastic deformation of 
    139         !!  pack ice by ridging, J. Geophys. Res., 80, 4514-4519. 
    140         !! 
    141         !! Thorndike, A. S., D. A. Rothrock, G. A. Maykut, and R. Colony,  
    142         !!  1975: The thickness distribution of sea ice, J. Geophys. Res.,  
    143         !!  80, 4501-4513.  
    144         !! 
    145         !! Bitz et al., JGR 2001 
    146         !! 
    147         !! Amundrud and Melling, JGR 2005 
    148         !! 
    149         !! Babko et al., JGR 2002  
    150         !! 
    151         !! ** History : 
    152         !!           This routine is based on CICE code 
    153         !!           and authors William H. Lipscomb, 
    154         !!           and Elizabeth C. Hunke, LANL 
    155         !!           are gratefully acknowledged 
    156         !! 
    157         !!           (02-2006) Martin Vancoppenolle, UCL-ASTR  
    158         !! 
    159         !!--------------------------------------------------------------------! 
    160         !! * Arguments 
    161  
    162         !! * Local variables 
    163         INTEGER ::   ji,       &   ! spatial dummy loop index 
    164                      jj,       &   ! spatial dummy loop index 
    165                      jk,       &   ! vertical layering dummy loop index 
    166                      jl,       &   ! ice category dummy loop index 
    167                      niter,    &   ! iteration counter 
    168                      nitermax = 20 ! max number of ridging iterations  
    169  
    170         REAL(wp)  ::             &  ! constant values 
    171            zeps      =  1.0e-10, & 
    172            epsi10    =  1.0e-10, & 
    173            epsi06    =  1.0e-6 
    174  
    175         REAL(wp), DIMENSION(jpi,jpj) :: & 
    176            closing_net,        &  ! net rate at which area is removed    (1/s) 
    177                                   ! (ridging ice area - area of new ridges) / dt 
    178            divu_adv   ,        &  ! divu as implied by transport scheme  (1/s) 
    179            opning     ,        &  ! rate of opening due to divergence/shear 
    180            closing_gross,      &  ! rate at which area removed, not counting 
    181                                   ! area of new ridges 
    182            msnow_mlt  ,        &  ! mass of snow added to ocean (kg m-2) 
    183            esnow_mlt              ! energy needed to melt snow in ocean (J m-2) 
    184  
    185         REAL(wp) ::            & 
    186            w1,                 &  ! temporary variable 
    187            tmpfac,             &  ! factor by which opening/closing rates are cut 
    188            dti                    ! 1 / dt 
    189  
    190         LOGICAL   ::           & 
    191            asum_error              ! flag for asum .ne. 1 
    192  
    193         INTEGER :: iterate_ridging ! if true, repeat the ridging 
    194  
    195         REAL(wp) ::  &          
    196            big = 1.0e8 
    197  
    198         REAL (wp), DIMENSION(jpi,jpj) :: &  !  
    199            vt_i_init, vt_i_final       !  ice volume summed over categories 
    200  
    201         CHARACTER (len = 15) :: fieldid 
    202  
    203 !!-- End of declarations 
    204 !-----------------------------------------------------------------------------! 
     103      !!---------------------------------------------------------------------! 
     104      !!                ***  ROUTINE lim_itd_me *** 
     105      !! ** Purpose : 
     106      !!        This routine computes the mechanical redistribution 
     107      !!                      of ice thickness 
     108      !! 
     109      !! ** Method  : a very simple method :-) 
     110      !! 
     111      !! ** Arguments : 
     112      !!           kideb , kiut : Starting and ending points on which the  
     113      !!                         the computation is applied 
     114      !! 
     115      !! ** Inputs / Ouputs : (global commons) 
     116      !! 
     117      !! ** External :  
     118      !! 
     119      !! ** Steps : 
     120      !!  1) Thickness categories boundaries, ice / o.w. concentrations 
     121      !!     Ridge preparation 
     122      !!  2) Dynamical inputs (closing rate, divu_adv, opning) 
     123      !!  3) Ridging iteration 
     124      !!  4) Ridging diagnostics 
     125      !!  5) Heat, salt and freshwater fluxes 
     126      !!  6) Compute increments of tate variables and come back to old values 
     127      !! 
     128      !! ** References : There are a lot of references and can be difficult /  
     129      !!                 boring to read 
     130      !! 
     131      !! Flato, G. M., and W. D. Hibler III, 1995: Ridging and strength 
     132      !!  in modeling the thickness distribution of Arctic sea ice, 
     133      !!  J. Geophys. Res., 100, 18,611-18,626. 
     134      !! 
     135      !! Hibler, W. D. III, 1980: Modeling a variable thickness sea ice 
     136      !!  cover, Mon. Wea. Rev., 108, 1943-1973, 1980. 
     137      !! 
     138      !! Rothrock, D. A., 1975: The energetics of the plastic deformation of 
     139      !!  pack ice by ridging, J. Geophys. Res., 80, 4514-4519. 
     140      !! 
     141      !! Thorndike, A. S., D. A. Rothrock, G. A. Maykut, and R. Colony,  
     142      !!  1975: The thickness distribution of sea ice, J. Geophys. Res.,  
     143      !!  80, 4501-4513.  
     144      !! 
     145      !! Bitz et al., JGR 2001 
     146      !! 
     147      !! Amundrud and Melling, JGR 2005 
     148      !! 
     149      !! Babko et al., JGR 2002  
     150      !! 
     151      !! ** History : 
     152      !!           This routine is based on CICE code 
     153      !!           and authors William H. Lipscomb, 
     154      !!           and Elizabeth C. Hunke, LANL 
     155      !!           are gratefully acknowledged 
     156      !! 
     157      !!           (02-2006) Martin Vancoppenolle, UCL-ASTR  
     158      !! 
     159      !!--------------------------------------------------------------------! 
     160      !! * Arguments 
     161 
     162      !! * Local variables 
     163      INTEGER ::   ji,       &   ! spatial dummy loop index 
     164         jj,       &   ! spatial dummy loop index 
     165         jk,       &   ! vertical layering dummy loop index 
     166         jl,       &   ! ice category dummy loop index 
     167         niter,    &   ! iteration counter 
     168         nitermax = 20 ! max number of ridging iterations  
     169 
     170      REAL(wp)  ::             &  ! constant values 
     171         zeps      =  1.0e-10, & 
     172         epsi10    =  1.0e-10, & 
     173         epsi06    =  1.0e-6 
     174 
     175      REAL(wp), DIMENSION(jpi,jpj) :: & 
     176         closing_net,        &  ! net rate at which area is removed    (1/s) 
     177                                ! (ridging ice area - area of new ridges) / dt 
     178         divu_adv   ,        &  ! divu as implied by transport scheme  (1/s) 
     179         opning     ,        &  ! rate of opening due to divergence/shear 
     180         closing_gross,      &  ! rate at which area removed, not counting 
     181                                ! area of new ridges 
     182         msnow_mlt  ,        &  ! mass of snow added to ocean (kg m-2) 
     183         esnow_mlt              ! energy needed to melt snow in ocean (J m-2) 
     184 
     185      REAL(wp) ::            & 
     186         w1,                 &  ! temporary variable 
     187         tmpfac,             &  ! factor by which opening/closing rates are cut 
     188         dti                    ! 1 / dt 
     189 
     190      LOGICAL   ::           & 
     191         asum_error              ! flag for asum .ne. 1 
     192 
     193      INTEGER :: iterate_ridging ! if true, repeat the ridging 
     194 
     195      REAL(wp) ::  &          
     196         big = 1.0e8 
     197 
     198      REAL (wp), DIMENSION(jpi,jpj) :: &  !  
     199         vt_i_init, vt_i_final       !  ice volume summed over categories 
     200 
     201      CHARACTER (len = 15) :: fieldid 
     202 
     203      !!-- End of declarations 
     204      !-----------------------------------------------------------------------------! 
    205205 
    206206      IF( numit == nstart  ) CALL lim_itd_me_init ! Initialization (first time-step only) 
    … …  
    211211      ENDIF 
    212212 
    213 !-----------------------------------------------------------------------------! 
    214 ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons 
    215 !-----------------------------------------------------------------------------! 
    216 ! Set hi_max(ncat) to a big value to ensure that all ridged ice  
    217 ! is thinner than hi_max(ncat). 
     213      !-----------------------------------------------------------------------------! 
     214      ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons 
     215      !-----------------------------------------------------------------------------! 
     216      ! Set hi_max(ncat) to a big value to ensure that all ridged ice  
     217      ! is thinner than hi_max(ncat). 
    218218 
    219219      hi_max(jpl) = 999.99 
    … …  
    225225      IF ( con_i) CALL lim_column_sum (jpl,   v_i, vt_i_init) 
    226226 
    227 ! Initialize arrays. 
     227      ! Initialize arrays. 
    228228      DO jj = 1, jpj 
    229229         DO ji = 1, jpi 
    230230 
    231          msnow_mlt(ji,jj) = 0.0 
    232          esnow_mlt(ji,jj) = 0.0 
    233          dardg1dt(ji,jj)  = 0.0 
    234          dardg2dt(ji,jj)  = 0.0 
    235          dvirdgdt(ji,jj)  = 0.0 
    236          opening (ji,jj)  = 0.0 
    237  
    238 !-----------------------------------------------------------------------------! 
    239 ! 2) Dynamical inputs (closing rate, divu_adv, opning) 
    240 !-----------------------------------------------------------------------------! 
    241 ! 
    242 ! 2.1 closing_net 
    243 !----------------- 
    244 ! Compute the net rate of closing due to convergence  
    245 ! and shear, based on Flato and Hibler (1995). 
    246 !  
    247 ! The energy dissipation rate is equal to the net closing rate 
    248 ! times the ice strength. 
    249 ! 
    250 ! NOTE: The NET closing rate is equal to the rate that open water  
    251 !  area is removed, plus the rate at which ice area is removed by  
    252 !  ridging, minus the rate at which area is added in new ridges. 
    253 !  The GROSS closing rate is equal to the first two terms (open 
    254 !  water closing and thin ice ridging) without the third term 
    255 !  (thick, newly ridged ice). 
    256  
    257          closing_net(ji,jj) = & 
    258               Cs*0.5*(Delta_i(ji,jj)-ABS(divu_i(ji,jj))) - MIN(divu_i(ji,jj),0.0) 
    259  
    260 ! 2.2 divu_adv 
    261 !-------------- 
    262 ! Compute divu_adv, the divergence rate given by the transport/ 
    263 ! advection scheme, which may not be equal to divu as computed  
    264 ! from the velocity field. 
    265 ! 
    266 ! If divu_adv < 0, make sure the closing rate is large enough 
    267 ! to give asum = 1.0 after ridging. 
    268  
    269          divu_adv(ji,jj) = (1.0-asum(ji,jj)) / rdt_ice  ! asum found in ridgeprep 
    270  
    271          IF (divu_adv(ji,jj) .LT. 0.0) & 
    272               closing_net(ji,jj) = max(closing_net(ji,jj), -divu_adv(ji,jj)) 
    273  
    274 ! 2.3 opning 
    275 !------------ 
    276 ! Compute the (non-negative) opening rate that will give  
    277 ! asum = 1.0 after ridging. 
    278          opning(ji,jj) = closing_net(ji,jj) + divu_adv(ji,jj) 
     231            msnow_mlt(ji,jj) = 0.0 
     232            esnow_mlt(ji,jj) = 0.0 
     233            dardg1dt(ji,jj)  = 0.0 
     234            dardg2dt(ji,jj)  = 0.0 
     235            dvirdgdt(ji,jj)  = 0.0 
     236            opening (ji,jj)  = 0.0 
     237 
     238            !-----------------------------------------------------------------------------! 
     239            ! 2) Dynamical inputs (closing rate, divu_adv, opning) 
     240            !-----------------------------------------------------------------------------! 
     241            ! 
     242            ! 2.1 closing_net 
     243            !----------------- 
     244            ! Compute the net rate of closing due to convergence  
     245            ! and shear, based on Flato and Hibler (1995). 
     246            !  
     247            ! The energy dissipation rate is equal to the net closing rate 
     248            ! times the ice strength. 
     249            ! 
     250            ! NOTE: The NET closing rate is equal to the rate that open water  
     251            !  area is removed, plus the rate at which ice area is removed by  
     252            !  ridging, minus the rate at which area is added in new ridges. 
     253            !  The GROSS closing rate is equal to the first two terms (open 
     254            !  water closing and thin ice ridging) without the third term 
     255            !  (thick, newly ridged ice). 
     256 
     257            closing_net(ji,jj) = & 
     258               Cs*0.5*(Delta_i(ji,jj)-ABS(divu_i(ji,jj))) - MIN(divu_i(ji,jj),0.0) 
     259 
     260            ! 2.2 divu_adv 
     261            !-------------- 
     262            ! Compute divu_adv, the divergence rate given by the transport/ 
     263            ! advection scheme, which may not be equal to divu as computed  
     264            ! from the velocity field. 
     265            ! 
     266            ! If divu_adv < 0, make sure the closing rate is large enough 
     267            ! to give asum = 1.0 after ridging. 
     268 
     269            divu_adv(ji,jj) = (1.0-asum(ji,jj)) / rdt_ice  ! asum found in ridgeprep 
     270 
     271            IF (divu_adv(ji,jj) .LT. 0.0) & 
     272               closing_net(ji,jj) = max(closing_net(ji,jj), -divu_adv(ji,jj)) 
     273 
     274            ! 2.3 opning 
     275            !------------ 
     276            ! Compute the (non-negative) opening rate that will give  
     277            ! asum = 1.0 after ridging. 
     278            opning(ji,jj) = closing_net(ji,jj) + divu_adv(ji,jj) 
    279279 
    280280         END DO 
    281281      END DO 
    282282 
    283 !-----------------------------------------------------------------------------! 
    284 ! 3) Ridging iteration 
    285 !-----------------------------------------------------------------------------! 
     283      !-----------------------------------------------------------------------------! 
     284      ! 3) Ridging iteration 
     285      !-----------------------------------------------------------------------------! 
    286286      niter = 1                 ! iteration counter 
    287287      iterate_ridging = 1 
    … …  
    290290      DO WHILE ( iterate_ridging > 0 .AND. niter < nitermax ) 
    291291 
     292         DO jj = 1, jpj 
     293            DO ji = 1, jpi 
     294 
     295               ! 3.2 closing_gross 
     296               !-----------------------------------------------------------------------------! 
     297               ! Based on the ITD of ridging and ridged ice, convert the net 
     298               !  closing rate to a gross closing rate.   
     299               ! NOTE: 0 < aksum <= 1 
     300               closing_gross(ji,jj) = closing_net(ji,jj) / aksum(ji,jj) 
     301 
     302               ! correction to closing rate and opening if closing rate is excessive 
     303               !--------------------------------------------------------------------- 
     304               ! Reduce the closing rate if more than 100% of the open water  
     305               ! would be removed.  Reduce the opening rate proportionately. 
     306               IF ( ato_i(ji,jj) .GT. epsi11 .AND. athorn(ji,jj,0) .GT. 0.0 ) THEN 
     307                  w1 = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 
     308                  IF ( w1 .GT. ato_i(ji,jj)) THEN 
     309                     tmpfac = ato_i(ji,jj) / w1 
     310                     closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac 
     311                     opning(ji,jj) = opning(ji,jj) * tmpfac 
     312                  ENDIF !w1 
     313               ENDIF !at0i and athorn 
     314 
     315            END DO ! ji 
     316         END DO ! jj 
     317 
     318         ! correction to closing rate / opening if excessive ice removal 
     319         !--------------------------------------------------------------- 
     320         ! Reduce the closing rate if more than 100% of any ice category  
     321         ! would be removed.  Reduce the opening rate proportionately. 
     322 
     323         DO jl = 1, jpl 
     324            DO jj = 1, jpj 
     325               DO ji = 1, jpi 
     326                  IF ( a_i(ji,jj,jl) .GT. epsi11 .AND. athorn(ji,jj,jl) .GT. 0.0 ) THEN 
     327                     w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
     328                     IF ( w1 .GT. a_i(ji,jj,jl) ) THEN 
     329                        tmpfac = a_i(ji,jj,jl) / w1 
     330                        closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac 
     331                        opning(ji,jj) = opning(ji,jj) * tmpfac 
     332                     ENDIF 
     333                  ENDIF 
     334               END DO !ji 
     335            END DO ! jj 
     336         END DO !jl 
     337 
     338         ! 3.3 Redistribute area, volume, and energy. 
     339         !-----------------------------------------------------------------------------! 
     340 
     341         CALL lim_itd_me_ridgeshift (opning,    closing_gross, & 
     342            msnow_mlt, esnow_mlt) 
     343 
     344         ! 3.4 Compute total area of ice plus open water after ridging. 
     345         !-----------------------------------------------------------------------------! 
     346 
     347         CALL lim_itd_me_asumr 
     348 
     349         ! 3.5 Do we keep on iterating ??? 
     350         !-----------------------------------------------------------------------------! 
     351         ! Check whether asum = 1.  If not (because the closing and opening 
     352         ! rates were reduced above), ridge again with new rates. 
     353 
     354         iterate_ridging = 0 
     355 
     356         DO jj = 1, jpj 
     357            DO ji = 1, jpi 
     358               IF (ABS(asum(ji,jj) - 1.0) .LT. epsi11) THEN 
     359                  closing_net(ji,jj) = 0.0  
     360                  opning(ji,jj)      = 0.0 
     361               ELSE 
     362                  iterate_ridging    = 1 
     363                  divu_adv(ji,jj)    = (1.0 - asum(ji,jj)) / rdt_ice 
     364                  closing_net(ji,jj) = MAX(0.0, -divu_adv(ji,jj)) 
     365                  opning(ji,jj)      = MAX(0.0, divu_adv(ji,jj)) 
     366               ENDIF 
     367            END DO 
     368         END DO 
     369 
     370         IF( lk_mpp ) CALL mpp_max(iterate_ridging) 
     371 
     372         ! Repeat if necessary. 
     373         ! NOTE: If strength smoothing is turned on, the ridging must be 
     374         ! iterated globally because of the boundary update in the  
     375         ! smoothing. 
     376 
     377         niter = niter + 1 
     378 
     379         IF (iterate_ridging == 1) THEN 
     380            IF (niter .GT. nitermax) THEN 
     381               WRITE(numout,*) ' ALERTE : non-converging ridging scheme ' 
     382               WRITE(numout,*) ' niter, iterate_ridging ', niter, iterate_ridging 
     383            ENDIF 
     384            CALL lim_itd_me_ridgeprep 
     385         ENDIF 
     386 
     387      END DO !! on the do while over iter 
     388 
     389      !-----------------------------------------------------------------------------! 
     390      ! 4) Ridging diagnostics 
     391      !-----------------------------------------------------------------------------! 
     392      ! Convert ridging rate diagnostics to correct units. 
     393      ! Update fresh water and heat fluxes due to snow melt. 
     394 
     395      dti = 1.0/rdt_ice 
     396 
     397      asum_error = .false.  
     398 
    292399      DO jj = 1, jpj 
    293400         DO ji = 1, jpi 
    294401 
    295 ! 3.2 closing_gross 
    296 !-----------------------------------------------------------------------------! 
    297 ! Based on the ITD of ridging and ridged ice, convert the net 
    298 !  closing rate to a gross closing rate.   
    299 ! NOTE: 0 < aksum <= 1 
    300             closing_gross(ji,jj) = closing_net(ji,jj) / aksum(ji,jj) 
    301  
    302 ! correction to closing rate and opening if closing rate is excessive 
    303 !--------------------------------------------------------------------- 
    304 ! Reduce the closing rate if more than 100% of the open water  
    305 ! would be removed.  Reduce the opening rate proportionately. 
    306             IF ( ato_i(ji,jj) .GT. epsi11 .AND. athorn(ji,jj,0) .GT. 0.0 ) THEN 
    307                w1 = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 
    308                IF ( w1 .GT. ato_i(ji,jj)) THEN 
    309                   tmpfac = ato_i(ji,jj) / w1 
    310                   closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac 
    311                   opning(ji,jj) = opning(ji,jj) * tmpfac 
    312                ENDIF !w1 
    313             ENDIF !at0i and athorn 
    314  
    315          END DO ! ji 
    316       END DO ! jj 
    317  
    318 ! correction to closing rate / opening if excessive ice removal 
    319 !--------------------------------------------------------------- 
    320 ! Reduce the closing rate if more than 100% of any ice category  
    321 ! would be removed.  Reduce the opening rate proportionately. 
    322  
    323       DO jl = 1, jpl 
    324          DO jj = 1, jpj 
    325             DO ji = 1, jpi 
    326                IF ( a_i(ji,jj,jl) .GT. epsi11 .AND. athorn(ji,jj,jl) .GT. 0.0 ) THEN 
    327                   w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
    328                   IF ( w1 .GT. a_i(ji,jj,jl) ) THEN 
    329                      tmpfac = a_i(ji,jj,jl) / w1 
    330                      closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac 
    331                      opning(ji,jj) = opning(ji,jj) * tmpfac 
    332                   ENDIF 
    333                ENDIF 
    334             END DO !ji 
    335          END DO ! jj 
    336       END DO !jl 
    337  
    338 ! 3.3 Redistribute area, volume, and energy. 
    339 !-----------------------------------------------------------------------------! 
    340  
    341       CALL lim_itd_me_ridgeshift (opning,    closing_gross, & 
    342                         msnow_mlt, esnow_mlt) 
    343  
    344 ! 3.4 Compute total area of ice plus open water after ridging. 
    345 !-----------------------------------------------------------------------------! 
    346  
    347       CALL lim_itd_me_asumr 
    348  
    349 ! 3.5 Do we keep on iterating ??? 
    350 !-----------------------------------------------------------------------------! 
    351 ! Check whether asum = 1.  If not (because the closing and opening 
    352 ! rates were reduced above), ridge again with new rates. 
    353  
    354       iterate_ridging = 0 
    355  
    356       DO jj = 1, jpj 
    357          DO ji = 1, jpi 
    358             IF (ABS(asum(ji,jj) - 1.0) .LT. epsi11) THEN 
    359                closing_net(ji,jj) = 0.0  
    360                opning(ji,jj)      = 0.0 
    361             ELSE 
    362                iterate_ridging    = 1 
    363                divu_adv(ji,jj)    = (1.0 - asum(ji,jj)) / rdt_ice 
    364                closing_net(ji,jj) = MAX(0.0, -divu_adv(ji,jj)) 
    365                opning(ji,jj)      = MAX(0.0, divu_adv(ji,jj)) 
    366             ENDIF 
    367          END DO 
    368       END DO 
    369  
    370       IF( lk_mpp ) CALL mpp_max(iterate_ridging) 
    371  
    372 ! Repeat if necessary. 
    373 ! NOTE: If strength smoothing is turned on, the ridging must be 
    374 ! iterated globally because of the boundary update in the  
    375 ! smoothing. 
    376  
    377       niter = niter + 1 
    378  
    379       IF (iterate_ridging == 1) THEN 
    380          IF (niter .GT. nitermax) THEN 
    381             WRITE(numout,*) ' ALERTE : non-converging ridging scheme ' 
    382             WRITE(numout,*) ' niter, iterate_ridging ', niter, iterate_ridging 
    383          ENDIF 
    384          CALL lim_itd_me_ridgeprep 
    385       ENDIF 
    386  
    387       END DO !! on the do while over iter 
    388  
    389 !-----------------------------------------------------------------------------! 
    390 ! 4) Ridging diagnostics 
    391 !-----------------------------------------------------------------------------! 
    392 ! Convert ridging rate diagnostics to correct units. 
    393 ! Update fresh water and heat fluxes due to snow melt. 
    394  
    395       dti = 1.0/rdt_ice 
    396  
    397       asum_error = .false.  
    398  
    399       DO jj = 1, jpj 
    400          DO ji = 1, jpi 
    401  
    402          IF (ABS(asum(ji,jj) - 1.0) .GT. epsi11) asum_error = .true. 
    403  
    404          dardg1dt(ji,jj) = dardg1dt(ji,jj) * dti 
    405          dardg2dt(ji,jj) = dardg2dt(ji,jj) * dti 
    406          dvirdgdt(ji,jj) = dvirdgdt(ji,jj) * dti 
    407          opening (ji,jj) = opening (ji,jj) * dti 
    408  
    409 !-----------------------------------------------------------------------------! 
    410 ! 5) Heat, salt and freshwater fluxes 
    411 !-----------------------------------------------------------------------------! 
    412          ! fresh water source for ocean 
    413          fmmec(ji,jj)      = fmmec(ji,jj)      + msnow_mlt(ji,jj)*dti   
    414        
    415          ! heat sink for ocean 
    416          fhmec(ji,jj)      = fhmec(ji,jj)      + esnow_mlt(ji,jj)*dti 
     402            IF (ABS(asum(ji,jj) - 1.0) .GT. epsi11) asum_error = .true. 
     403 
     404            dardg1dt(ji,jj) = dardg1dt(ji,jj) * dti 
     405            dardg2dt(ji,jj) = dardg2dt(ji,jj) * dti 
     406            dvirdgdt(ji,jj) = dvirdgdt(ji,jj) * dti 
     407            opening (ji,jj) = opening (ji,jj) * dti 
     408 
     409            !-----------------------------------------------------------------------------! 
     410            ! 5) Heat, salt and freshwater fluxes 
     411            !-----------------------------------------------------------------------------! 
     412            ! fresh water source for ocean 
     413            fmmec(ji,jj)      = fmmec(ji,jj)      + msnow_mlt(ji,jj)*dti   
     414 
     415            ! heat sink for ocean 
     416            fhmec(ji,jj)      = fhmec(ji,jj)      + esnow_mlt(ji,jj)*dti 
    417417 
    418418         END DO 
    … …  
    444444      ENDIF 
    445445 
    446 !-----------------------------------------------------------------------------! 
    447 ! 6) Updating state variables and trend terms 
    448 !-----------------------------------------------------------------------------! 
     446      !-----------------------------------------------------------------------------! 
     447      ! 6) Updating state variables and trend terms 
     448      !-----------------------------------------------------------------------------! 
    449449 
    450450      CALL lim_var_glo2eqv 
    … …  
    465465      d_smv_i_trp(:,:,:)   = 0.0 
    466466      IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 
    467       d_smv_i_trp(:,:,:)  = smv_i(:,:,:) - old_smv_i(:,:,:) 
     467         d_smv_i_trp(:,:,:)  = smv_i(:,:,:) - old_smv_i(:,:,:) 
    468468 
    469469      IF(ln_ctl) THEN     ! Control print 
    … …  
    513513      oa_i(:,:,:)   = old_oa_i(:,:,:) 
    514514      IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) &  
    515       smv_i(:,:,:)  = old_smv_i(:,:,:) 
     515         smv_i(:,:,:)  = old_smv_i(:,:,:) 
    516516 
    517517      !----------------------------------------------------! 
    … …  
    528528               DO ji = 1, jpi 
    529529                  IF ( ( old_v_i(ji,jj,jl) .LT. epsi06 ) .AND. & 
    530                        ( d_v_i_trp(ji,jj,jl) .GT. epsi06 ) ) THEN 
    531                       old_e_i(ji,jj,jk,jl)   = d_e_i_trp(ji,jj,jk,jl) 
    532                       d_e_i_trp(ji,jj,jk,jl) = 0.0 
     530                     ( d_v_i_trp(ji,jj,jl) .GT. epsi06 ) ) THEN 
     531                     old_e_i(ji,jj,jk,jl)   = d_e_i_trp(ji,jj,jk,jl) 
     532                     d_e_i_trp(ji,jj,jk,jl) = 0.0 
    533533                  ENDIF 
    534534               END DO 
    … …  
    541541            DO ji = 1, jpi 
    542542               IF ( ( old_v_i(ji,jj,jl) .LT. epsi06 ) .AND. & 
    543                     ( d_v_i_trp(ji,jj,jl) .GT. epsi06 ) ) THEN 
    544                    old_v_i(ji,jj,jl)     = d_v_i_trp(ji,jj,jl) 
    545                    d_v_i_trp(ji,jj,jl)   = 0.0 
    546                    old_a_i(ji,jj,jl)     = d_a_i_trp(ji,jj,jl) 
    547                    d_a_i_trp(ji,jj,jl)   = 0.0 
    548                    old_v_s(ji,jj,jl)     = d_v_s_trp(ji,jj,jl) 
    549                    d_v_s_trp(ji,jj,jl)   = 0.0 
    550                    old_e_s(ji,jj,1,jl)   = d_e_s_trp(ji,jj,1,jl) 
    551                    d_e_s_trp(ji,jj,1,jl) = 0.0 
    552                    old_oa_i(ji,jj,jl)    = d_oa_i_trp(ji,jj,jl) 
    553                    d_oa_i_trp(ji,jj,jl)  = 0.0 
    554                    IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) &  
    555                    old_smv_i(ji,jj,jl)   = d_smv_i_trp(ji,jj,jl) 
    556                    d_smv_i_trp(ji,jj,jl) = 0.0 
     543                  ( d_v_i_trp(ji,jj,jl) .GT. epsi06 ) ) THEN 
     544                  old_v_i(ji,jj,jl)     = d_v_i_trp(ji,jj,jl) 
     545                  d_v_i_trp(ji,jj,jl)   = 0.0 
     546                  old_a_i(ji,jj,jl)     = d_a_i_trp(ji,jj,jl) 
     547                  d_a_i_trp(ji,jj,jl)   = 0.0 
     548                  old_v_s(ji,jj,jl)     = d_v_s_trp(ji,jj,jl) 
     549                  d_v_s_trp(ji,jj,jl)   = 0.0 
     550                  old_e_s(ji,jj,1,jl)   = d_e_s_trp(ji,jj,1,jl) 
     551                  d_e_s_trp(ji,jj,1,jl) = 0.0 
     552                  old_oa_i(ji,jj,jl)    = d_oa_i_trp(ji,jj,jl) 
     553                  d_oa_i_trp(ji,jj,jl)  = 0.0 
     554                  IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) &  
     555                     old_smv_i(ji,jj,jl)   = d_smv_i_trp(ji,jj,jl) 
     556                  d_smv_i_trp(ji,jj,jl) = 0.0 
    557557               ENDIF 
    558558            END DO 
    559559         END DO 
    560560      END DO 
    561           
     561 
    562562   END SUBROUTINE lim_itd_me 
    563563 
    564 !=============================================================================== 
     564   !=============================================================================== 
    565565 
    566566   SUBROUTINE lim_itd_me_icestrength (kstrngth) ! (subroutine 2/6) 
    567567 
    568         !!---------------------------------------------------------------------- 
    569         !!                ***  ROUTINE lim_itd_me_icestrength *** 
    570         !! ** Purpose : 
    571         !!        This routine computes ice strength used in dynamics routines 
    572         !!                      of ice thickness 
    573         !! 
    574         !! ** Method  : 
    575         !!       Compute the strength of the ice pack, defined as the energy (J m-2)  
    576         !! dissipated per unit area removed from the ice pack under compression, 
    577         !! and assumed proportional to the change in potential energy caused 
    578         !! by ridging. Note that only Hibler's formulation is stable and that 
    579         !! ice strength has to be smoothed 
    580         !! 
    581         !! ** Inputs / Ouputs : kstrngth (what kind of ice strength we are using) 
    582         !! 
    583         !! ** External :  
    584         !! 
    585         !! ** References : 
    586         !!                 
    587         !!---------------------------------------------------------------------- 
    588         !! * Arguments 
    589   
     568      !!---------------------------------------------------------------------- 
     569      !!                ***  ROUTINE lim_itd_me_icestrength *** 
     570      !! ** Purpose : 
     571      !!        This routine computes ice strength used in dynamics routines 
     572      !!                      of ice thickness 
     573      !! 
     574      !! ** Method  : 
     575      !!       Compute the strength of the ice pack, defined as the energy (J m-2)  
     576      !! dissipated per unit area removed from the ice pack under compression, 
     577      !! and assumed proportional to the change in potential energy caused 
     578      !! by ridging. Note that only Hibler's formulation is stable and that 
     579      !! ice strength has to be smoothed 
     580      !! 
     581      !! ** Inputs / Ouputs : kstrngth (what kind of ice strength we are using) 
     582      !! 
     583      !! ** External :  
     584      !! 
     585      !! ** References : 
     586      !!                 
     587      !!---------------------------------------------------------------------- 
     588      !! * Arguments 
     589 
    590590      INTEGER, INTENT(in) :: & 
    591591         kstrngth    ! = 1 for Rothrock formulation, 0 for Hibler (1979) 
    … …  
    606606         zworka              !: temporary array used here 
    607607 
    608 !------------------------------------------------------------------------------! 
    609 ! 1) Initialize 
    610 !------------------------------------------------------------------------------! 
     608      !------------------------------------------------------------------------------! 
     609      ! 1) Initialize 
     610      !------------------------------------------------------------------------------! 
    611611      strength(:,:) = 0.0 
    612612 
    613 !------------------------------------------------------------------------------! 
    614 ! 2) Compute thickness distribution of ridging and ridged ice 
    615 !------------------------------------------------------------------------------! 
     613      !------------------------------------------------------------------------------! 
     614      ! 2) Compute thickness distribution of ridging and ridged ice 
     615      !------------------------------------------------------------------------------! 
    616616      CALL lim_itd_me_ridgeprep 
    617617 
    618 !------------------------------------------------------------------------------! 
    619 ! 3) Rothrock(1975)'s method 
    620 !------------------------------------------------------------------------------! 
     618      !------------------------------------------------------------------------------! 
     619      ! 3) Rothrock(1975)'s method 
     620      !------------------------------------------------------------------------------! 
    621621      IF (kstrngth == 1) then 
    622622 
    … …  
    626626 
    627627                  IF(     ( a_i(ji,jj,jl)    .GT. epsi11 )                     & 
    628                     .AND. ( athorn(ji,jj,jl) .GT. 0.0    ) ) THEN 
     628                     .AND. ( athorn(ji,jj,jl) .GT. 0.0    ) ) THEN 
    629629                     hi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    630630                     !---------------------------- 
    … …  
    632632                     !---------------------------- 
    633633                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) *    & 
    634                      hi * hi 
     634                        hi * hi 
    635635 
    636636                     !-------------------------- 
    … …  
    638638                     !-------------------------- 
    639639                     strength(ji,jj) = strength(ji,jj) + 2.0 * araft(ji,jj,jl) & 
    640                      * hi * hi 
     640                        * hi * hi 
    641641 
    642642                     !---------------------------- 
    … …  
    644644                     !---------------------------- 
    645645                     strength(ji,jj) = strength(ji,jj)                         & 
    646                      + aridge(ji,jj,jl)/krdg(ji,jj,jl)                         & 
    647                      * 1.0/3.0 * (hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3)     & 
    648                      / (hrmax(ji,jj,jl)-hrmin(ji,jj,jl))                       
     646                        + aridge(ji,jj,jl)/krdg(ji,jj,jl)                         & 
     647                        * 1.0/3.0 * (hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3)     & 
     648                        / (hrmax(ji,jj,jl)-hrmin(ji,jj,jl))                       
    649649                  ENDIF            ! aicen > epsi11 
    650650 
    … …  
    656656            DO ji = 1, jpi 
    657657               strength(ji,jj) = Cf * Cp * strength(ji,jj) / aksum(ji,jj)  
    658                           ! Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) 
    659                           ! Cf accounts for frictional dissipation 
    660                 
     658               ! Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) 
     659               ! Cf accounts for frictional dissipation 
     660 
    661661            END DO              ! j 
    662662         END DO                 ! i 
    … …  
    664664         ksmooth = 1 
    665665 
    666 !------------------------------------------------------------------------------! 
    667 ! 4) Hibler (1979)' method 
    668 !------------------------------------------------------------------------------! 
     666         !------------------------------------------------------------------------------! 
     667         ! 4) Hibler (1979)' method 
     668         !------------------------------------------------------------------------------! 
    669669      ELSE                      ! kstrngth ne 1:  Hibler (1979) form 
    670670 
    … …  
    679679      ENDIF                     ! kstrngth 
    680680 
    681 ! 
    682 !------------------------------------------------------------------------------! 
    683 ! 5) Impact of brine volume 
    684 !------------------------------------------------------------------------------! 
    685 ! CAN BE REMOVED 
    686 ! 
     681      ! 
     682      !------------------------------------------------------------------------------! 
     683      ! 5) Impact of brine volume 
     684      !------------------------------------------------------------------------------! 
     685      ! CAN BE REMOVED 
     686      ! 
    687687      IF ( brinstren_swi .EQ. 1 ) THEN 
    688688 
    … …  
    700700      ENDIF 
    701701 
    702 ! 
    703 !------------------------------------------------------------------------------! 
    704 ! 6) Smoothing ice strength 
    705 !------------------------------------------------------------------------------! 
    706 ! 
     702      ! 
     703      !------------------------------------------------------------------------------! 
     704      ! 6) Smoothing ice strength 
     705      !------------------------------------------------------------------------------! 
     706      ! 
    707707      !------------------- 
    708708      ! Spatial smoothing 
    … …  
    715715            DO ji = 2, jpi - 1 
    716716               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi11) THEN ! ice is 
    717                                                                      ! present 
     717                  ! present 
    718718                  zworka(ji,jj) = 4.0 * strength(ji,jj)              & 
    719                                   + strength(ji-1,jj) * tms(ji-1,jj) &   
    720                                   + strength(ji+1,jj) * tms(ji+1,jj) &   
    721                                   + strength(ji,jj-1) * tms(ji,jj-1) &   
    722                                   + strength(ji,jj+1) * tms(ji,jj+1)     
     719                     + strength(ji-1,jj) * tms(ji-1,jj) &   
     720                     + strength(ji+1,jj) * tms(ji+1,jj) &   
     721                     + strength(ji,jj-1) * tms(ji,jj-1) &   
     722                     + strength(ji,jj+1) * tms(ji,jj+1)     
    723723 
    724724                  zw1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj)            & 
    725                             + tms(ji,jj-1) + tms(ji,jj+1) 
     725                     + tms(ji,jj-1) + tms(ji,jj+1) 
    726726                  zworka(ji,jj) = zworka(ji,jj) / zw1 
    727727               ELSE 
    … …  
    749749 
    750750      IF ( ksmooth .EQ. 2 ) THEN 
    751                   
    752           
     751 
     752 
    753753         CALL lbc_lnk( strength, 'T', 1. ) 
    754              
     754 
    755755         DO jj = 1, jpj - 1 
    756756            DO ji = 1, jpi - 1 
    757757               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi11) THEN ! ice is 
    758                                                                      ! present 
     758                  ! present 
    759759                  numts_rm = 1 ! number of time steps for the running mean 
    760760                  IF ( strp1(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1 
    761761                  IF ( strp2(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1 
    762762                  zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) /   & 
    763                        numts_rm 
     763                     numts_rm 
    764764                  strp2(ji,jj) = strp1(ji,jj) 
    765765                  strp1(ji,jj) = strength(ji,jj) 
    … …  
    771771 
    772772      ENDIF ! ksmooth 
    773        
     773 
    774774      ! Boundary conditions 
    775775      CALL lbc_lnk( strength, 'T', 1. ) 
    776776 
    777       END SUBROUTINE lim_itd_me_icestrength 
    778  
    779 !=============================================================================== 
    780  
    781       SUBROUTINE lim_itd_me_ridgeprep !(subroutine 3/6) 
    782  
    783         !!---------------------------------------------------------------------! 
    784         !!                ***  ROUTINE lim_itd_me_ridgeprep *** 
    785         !! ** Purpose : 
    786         !!         preparation for ridging and strength calculations 
    787         !! 
    788         !! ** Method  : 
    789         !! Compute the thickness distribution of the ice and open water  
    790         !! participating in ridging and of the resulting ridges. 
    791         !! 
    792         !! ** Arguments : 
    793         !! 
    794         !! ** External :  
    795         !! 
    796         !!---------------------------------------------------------------------! 
    797         !! * Arguments 
    798   
     777   END SUBROUTINE lim_itd_me_icestrength 
     778 
     779   !=============================================================================== 
     780 
     781   SUBROUTINE lim_itd_me_ridgeprep !(subroutine 3/6) 
     782 
     783      !!---------------------------------------------------------------------! 
     784      !!                ***  ROUTINE lim_itd_me_ridgeprep *** 
     785      !! ** Purpose : 
     786      !!         preparation for ridging and strength calculations 
     787      !! 
     788      !! ** Method  : 
     789      !! Compute the thickness distribution of the ice and open water  
     790      !! participating in ridging and of the resulting ridges. 
     791      !! 
     792      !! ** Arguments : 
     793      !! 
     794      !! ** External :  
     795      !! 
     796      !!---------------------------------------------------------------------! 
     797      !! * Arguments 
     798 
    799799      INTEGER :: & 
    800800         ji,jj,  &          ! horizontal indices 
    … …  
    820820         epsi06 = 1.0e-6 
    821821 
    822 !------------------------------------------------------------------------------! 
     822      !------------------------------------------------------------------------------! 
    823823 
    824824      Gstari     = 1.0/Gstar     
    … …  
    833833      krdg (:,:,:)  = 1.0 
    834834 
    835 !     ! Zero out categories with very small areas 
     835      !     ! Zero out categories with very small areas 
    836836      CALL lim_itd_me_zapsmall 
    837837 
    838 !------------------------------------------------------------------------------! 
    839 ! 1) Participation function  
    840 !------------------------------------------------------------------------------! 
     838      !------------------------------------------------------------------------------! 
     839      ! 1) Participation function  
     840      !------------------------------------------------------------------------------! 
    841841 
    842842      ! Compute total area of ice plus open water. 
    … …  
    886886            DO ji = 1, jpi 
    887887               Gsum(ji,jj,jl) = Gsum(ji,jj,jl) * zworka(ji,jj) 
    888             END DO  
     888            END DO 
    889889         END DO 
    890890      END DO 
    891891 
    892 ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn) 
    893 !-------------------------------------------------------------------------------------------------- 
    894 ! Compute the participation function athorn; this is analogous to 
    895 ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975). 
    896 ! area lost from category n due to ridging/closing 
    897 ! athorn(n)   = total area lost due to ridging/closing 
    898 ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar).  
    899 ! 
    900 ! The expressions for athorn are found by integrating b(h)g(h) between 
    901 ! the category boundaries. 
    902 !----------------------------------------------------------------- 
     892      ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn) 
     893      !-------------------------------------------------------------------------------------------------- 
     894      ! Compute the participation function athorn; this is analogous to 
     895      ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975). 
     896      ! area lost from category n due to ridging/closing 
     897      ! athorn(n)   = total area lost due to ridging/closing 
     898      ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar).  
     899      ! 
     900      ! The expressions for athorn are found by integrating b(h)g(h) between 
     901      ! the category boundaries. 
     902      !----------------------------------------------------------------- 
    903903 
    904904      krdg_index = 1 
    … …  
    906906      IF ( krdg_index .EQ. 0 ) THEN 
    907907 
    908       !--- Linear formulation (Thorndike et al., 1975) 
    909       DO jl = 0, ice_cat_bounds(1,2) ! only undeformed ice participates 
    910          DO jj = 1, jpj  
    911             DO ji = 1, jpi 
    912                IF (Gsum(ji,jj,jl) < Gstar) THEN 
    913                   athorn(ji,jj,jl) = Gstari * (Gsum(ji,jj,jl)-Gsum(ji,jj,jl-1)) * & 
    914                        (2.0 - (Gsum(ji,jj,jl-1)+Gsum(ji,jj,jl))*Gstari) 
    915                ELSEIF (Gsum(ji,jj,jl-1) < Gstar) THEN 
    916                   athorn(ji,jj,jl) = Gstari * (Gstar-Gsum(ji,jj,jl-1)) *  & 
    917                        (2.0 - (Gsum(ji,jj,jl-1)+Gstar)*Gstari) 
    918                ELSE 
    919                   athorn(ji,jj,jl) = 0.0 
    920                ENDIF 
    921             END DO ! ji 
    922          END DO ! jj 
    923       END DO ! jl  
     908         !--- Linear formulation (Thorndike et al., 1975) 
     909         DO jl = 0, ice_cat_bounds(1,2) ! only undeformed ice participates 
     910            DO jj = 1, jpj  
     911               DO ji = 1, jpi 
     912                  IF (Gsum(ji,jj,jl) < Gstar) THEN 
     913                     athorn(ji,jj,jl) = Gstari * (Gsum(ji,jj,jl)-Gsum(ji,jj,jl-1)) * & 
     914                        (2.0 - (Gsum(ji,jj,jl-1)+Gsum(ji,jj,jl))*Gstari) 
     915                  ELSEIF (Gsum(ji,jj,jl-1) < Gstar) THEN 
     916                     athorn(ji,jj,jl) = Gstari * (Gstar-Gsum(ji,jj,jl-1)) *  & 
     917                        (2.0 - (Gsum(ji,jj,jl-1)+Gstar)*Gstari) 
     918                  ELSE 
     919                     athorn(ji,jj,jl) = 0.0 
     920                  ENDIF 
     921               END DO ! ji 
     922            END DO ! jj 
     923         END DO ! jl  
    924924 
    925925      ELSE ! krdg_index = 1 
    926        
    927       !--- Exponential, more stable formulation (Lipscomb et al, 2007) 
    928       ! precompute exponential terms using Gsum as a work array 
    929       zdummy = 1.0 / (1.0-EXP(-astari)) 
    930  
    931       DO jl = -1, jpl 
    932          DO jj = 1, jpj 
    933             DO ji = 1, jpi 
    934                Gsum(ji,jj,jl) = EXP(-Gsum(ji,jj,jl)*astari)*zdummy 
    935             END DO !ji 
    936          END DO !jj 
    937       END DO !jl 
    938  
    939       ! compute athorn 
    940       DO jl = 0, ice_cat_bounds(1,2) 
    941          DO jj = 1, jpj 
    942             DO ji = 1, jpi 
    943                athorn(ji,jj,jl) = Gsum(ji,jj,jl-1) - Gsum(ji,jj,jl) 
    944             END DO !ji 
    945          END DO ! jj 
    946       END DO !jl 
     926 
     927         !--- Exponential, more stable formulation (Lipscomb et al, 2007) 
     928         ! precompute exponential terms using Gsum as a work array 
     929         zdummy = 1.0 / (1.0-EXP(-astari)) 
     930 
     931         DO jl = -1, jpl 
     932            DO jj = 1, jpj 
     933               DO ji = 1, jpi 
     934                  Gsum(ji,jj,jl) = EXP(-Gsum(ji,jj,jl)*astari)*zdummy 
     935               END DO !ji 
     936            END DO !jj 
     937         END DO !jl 
     938 
     939         ! compute athorn 
     940         DO jl = 0, ice_cat_bounds(1,2) 
     941            DO jj = 1, jpj 
     942               DO ji = 1, jpi 
     943                  athorn(ji,jj,jl) = Gsum(ji,jj,jl-1) - Gsum(ji,jj,jl) 
     944               END DO !ji 
     945            END DO ! jj 
     946         END DO !jl 
    947947 
    948948      ENDIF ! krdg_index 
    … …  
    956956                  IF ( athorn(ji,jj,jl) .GT. 0.0 ) THEN 
    957957                     aridge(ji,jj,jl) = ( TANH ( Craft * ( ht_i(ji,jj,jl) - & 
    958                                           hparmeter ) ) + 1.0 ) / 2.0 * &  
    959                                           athorn(ji,jj,jl) 
     958                        hparmeter ) ) + 1.0 ) / 2.0 * &  
     959                        athorn(ji,jj,jl) 
    960960                     araft (ji,jj,jl) = ( TANH ( - Craft * ( ht_i(ji,jj,jl) - & 
    961                                           hparmeter ) ) + 1.0 ) / 2.0 * & 
    962                                           athorn(ji,jj,jl) 
     961                        hparmeter ) ) + 1.0 ) / 2.0 * & 
     962                        athorn(ji,jj,jl) 
    963963                     IF ( araft(ji,jj,jl) .LT. epsi06 ) araft(ji,jj,jl)  = 0.0 
    964964                     aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0) 
    … …  
    982982      IF ( raftswi .EQ. 1 ) THEN 
    983983 
    984       IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi11 ) THEN 
    985          DO jl = 1, jpl 
    986             DO jj = 1, jpj 
    987                DO ji = 1, jpi 
    988                   IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. & 
    989                   epsi11 ) THEN 
    990                      WRITE(numout,*) ' ALERTE 96 : wrong participation function ... ' 
    991                      WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl 
    992                      WRITE(numout,*) ' lat, lon   : ', gphit(ji,jj), glamt(ji,jj) 
    993                      WRITE(numout,*) ' aridge     : ', aridge(ji,jj,1:jpl) 
    994                      WRITE(numout,*) ' araft      : ', araft(ji,jj,1:jpl) 
    995                      WRITE(numout,*) ' athorn     : ', athorn(ji,jj,1:jpl) 
    996                   ENDIF 
     984         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi11 ) THEN 
     985            DO jl = 1, jpl 
     986               DO jj = 1, jpj 
     987                  DO ji = 1, jpi 
     988                     IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. & 
     989                        epsi11 ) THEN 
     990                        WRITE(numout,*) ' ALERTE 96 : wrong participation function ... ' 
     991                        WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl 
     992                        WRITE(numout,*) ' lat, lon   : ', gphit(ji,jj), glamt(ji,jj) 
     993                        WRITE(numout,*) ' aridge     : ', aridge(ji,jj,1:jpl) 
     994                        WRITE(numout,*) ' araft      : ', araft(ji,jj,1:jpl) 
     995                        WRITE(numout,*) ' athorn     : ', athorn(ji,jj,1:jpl) 
     996                     ENDIF 
     997                  END DO 
    997998               END DO 
    998999            END DO 
    999          END DO 
     1000         ENDIF 
     1001 
    10001002      ENDIF 
    10011003 
    1002       ENDIF 
    1003  
    1004 !----------------------------------------------------------------- 
    1005 ! 2) Transfer function 
    1006 !----------------------------------------------------------------- 
    1007 ! Compute max and min ridged ice thickness for each ridging category. 
    1008 ! Assume ridged ice is uniformly distributed between hrmin and hrmax. 
    1009 !  
    1010 ! This parameterization is a modified version of Hibler (1980). 
    1011 ! The mean ridging thickness, hrmean, is proportional to hi^(0.5) 
    1012 !  and for very thick ridging ice must be >= krdgmin*hi 
    1013 ! 
    1014 ! The minimum ridging thickness, hrmin, is equal to 2*hi  
    1015 !  (i.e., rafting) and for very thick ridging ice is 
    1016 !  constrained by hrmin <= (hrmean + hi)/2. 
    1017 !  
    1018 ! The maximum ridging thickness, hrmax, is determined by 
    1019 !  hrmean and hrmin. 
    1020 ! 
    1021 ! These modifications have the effect of reducing the ice strength 
    1022 ! (relative to the Hibler formulation) when very thick ice is 
    1023 ! ridging. 
    1024 ! 
    1025 ! aksum = net area removed/ total area removed 
    1026 ! where total area removed = area of ice that ridges 
    1027 !         net area removed = total area removed - area of new ridges 
    1028 !----------------------------------------------------------------- 
     1004      !----------------------------------------------------------------- 
     1005      ! 2) Transfer function 
     1006      !----------------------------------------------------------------- 
     1007      ! Compute max and min ridged ice thickness for each ridging category. 
     1008      ! Assume ridged ice is uniformly distributed between hrmin and hrmax. 
     1009      !  
     1010      ! This parameterization is a modified version of Hibler (1980). 
     1011      ! The mean ridging thickness, hrmean, is proportional to hi^(0.5) 
     1012      !  and for very thick ridging ice must be >= krdgmin*hi 
     1013      ! 
     1014      ! The minimum ridging thickness, hrmin, is equal to 2*hi  
     1015      !  (i.e., rafting) and for very thick ridging ice is 
     1016      !  constrained by hrmin <= (hrmean + hi)/2. 
     1017      !  
     1018      ! The maximum ridging thickness, hrmax, is determined by 
     1019      !  hrmean and hrmin. 
     1020      ! 
     1021      ! These modifications have the effect of reducing the ice strength 
     1022      ! (relative to the Hibler formulation) when very thick ice is 
     1023      ! ridging. 
     1024      ! 
     1025      ! aksum = net area removed/ total area removed 
     1026      ! where total area removed = area of ice that ridges 
     1027      !         net area removed = total area removed - area of new ridges 
     1028      !----------------------------------------------------------------- 
    10291029 
    10301030      ! Transfer function 
    … …  
    10621062            DO ji = 1, jpi 
    10631063               aksum(ji,jj)    = aksum(ji,jj)                          & 
    1064                        + aridge(ji,jj,jl) * (1.0 - 1.0/krdg(ji,jj,jl))    & 
    1065                        + araft (ji,jj,jl) * (1.0 - 1.0/kraft) 
     1064                  + aridge(ji,jj,jl) * (1.0 - 1.0/krdg(ji,jj,jl))    & 
     1065                  + araft (ji,jj,jl) * (1.0 - 1.0/kraft) 
    10661066            END DO 
    10671067         END DO 
    10681068      END DO 
    10691069 
    1070       END SUBROUTINE lim_itd_me_ridgeprep 
    1071  
    1072 !=============================================================================== 
    1073  
    1074       SUBROUTINE lim_itd_me_ridgeshift(opning,    closing_gross,       & 
    1075                               msnow_mlt, esnow_mlt) ! (subroutine 4/6) 
    1076  
    1077         !!----------------------------------------------------------------------------- 
    1078         !!                ***  ROUTINE lim_itd_me_icestrength *** 
    1079         !! ** Purpose : 
    1080         !!        This routine shift ridging ice among thickness categories 
    1081         !!                      of ice thickness 
    1082         !! 
    1083         !! ** Method  : 
    1084         !! Remove area, volume, and energy from each ridging category 
    1085         !! and add to thicker ice categories. 
    1086         !! 
    1087         !! ** Arguments : 
    1088         !! 
    1089         !! ** Inputs / Ouputs :  
    1090         !! 
    1091         !! ** External :  
    1092         !! 
     1070   END SUBROUTINE lim_itd_me_ridgeprep 
     1071 
     1072   !=============================================================================== 
     1073 
     1074   SUBROUTINE lim_itd_me_ridgeshift(opning,    closing_gross,       & 
     1075      msnow_mlt, esnow_mlt) ! (subroutine 4/6) 
     1076 
     1077      !!----------------------------------------------------------------------------- 
     1078      !!                ***  ROUTINE lim_itd_me_icestrength *** 
     1079      !! ** Purpose : 
     1080      !!        This routine shift ridging ice among thickness categories 
     1081      !!                      of ice thickness 
     1082      !! 
     1083      !! ** Method  : 
     1084      !! Remove area, volume, and energy from each ridging category 
     1085      !! and add to thicker ice categories. 
     1086      !! 
     1087      !! ** Arguments : 
     1088      !! 
     1089      !! ** Inputs / Ouputs :  
     1090      !! 
     1091      !! ** External :  
     1092      !! 
    10931093 
    10941094      REAL (wp), DIMENSION(jpi,jpj), INTENT(IN)   :: & 
    10951095         opning,         & ! rate of opening due to divergence/shear 
    10961096         closing_gross     ! rate at which area removed, not counting 
    1097                            ! area of new ridges 
     1097      ! area of new ridges 
    10981098 
    10991099      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: & 
    … …  
    11761176      LOGICAL, PARAMETER :: & 
    11771177         l_conservation_check = .true.  ! if true, check conservation  
    1178                                         ! (useful for debugging) 
     1178      ! (useful for debugging) 
    11791179      LOGICAL ::         & 
    11801180         neg_ato_i     , &  ! flag for ato_i(i,j) < -puny 
    … …  
    11871187         zindb              ! switch for the presence of ridge poros or not 
    11881188 
    1189    !---------------------------------------------------------------------------- 
     1189      !---------------------------------------------------------------------------- 
    11901190 
    11911191      ! Conservation check 
    … …  
    12021202      epsi10 = 1.0d-10 
    12031203 
    1204 !------------------------------------------------------------------------------- 
    1205 ! 1) Compute change in open water area due to closing and opening. 
    1206 !------------------------------------------------------------------------------- 
     1204      !------------------------------------------------------------------------------- 
     1205      ! 1) Compute change in open water area due to closing and opening. 
     1206      !------------------------------------------------------------------------------- 
    12071207 
    12081208      neg_ato_i = .false. 
    … …  
    12111211         DO ji = 1, jpi 
    12121212            ato_i(ji,jj) = ato_i(ji,jj)                                   & 
    1213                     - athorn(ji,jj,0)*closing_gross(ji,jj)*rdt_ice        & 
    1214                     + opning(ji,jj)*rdt_ice 
     1213               - athorn(ji,jj,0)*closing_gross(ji,jj)*rdt_ice        & 
     1214               + opning(ji,jj)*rdt_ice 
    12151215            IF (ato_i(ji,jj) .LT. -epsi11) THEN 
    12161216               neg_ato_i = .true. 
    … …  
    12341234      ENDIF                     ! neg_ato_i 
    12351235 
    1236 !----------------------------------------------------------------- 
    1237 ! 2) Save initial state variables 
    1238 !----------------------------------------------------------------- 
     1236      !----------------------------------------------------------------- 
     1237      ! 2) Save initial state variables 
     1238      !----------------------------------------------------------------- 
    12391239 
    12401240      DO jl = 1, jpl 
    … …  
    12521252 
    12531253      esnon_init(:,:,:) = e_s(:,:,1,:) 
    1254              
     1254 
    12551255      DO jl = 1, jpl   
    12561256         DO jk = 1, nlay_i 
    … …  
    12631263      END DO !jl 
    12641264 
    1265 ! 
    1266 !----------------------------------------------------------------- 
    1267 ! 3) Pump everything from ice which is being ridged / rafted 
    1268 !----------------------------------------------------------------- 
    1269 ! Compute the area, volume, and energy of ice ridging in each 
    1270 ! category, along with the area of the resulting ridge. 
     1265      ! 
     1266      !----------------------------------------------------------------- 
     1267      ! 3) Pump everything from ice which is being ridged / rafted 
     1268      !----------------------------------------------------------------- 
     1269      ! Compute the area, volume, and energy of ice ridging in each 
     1270      ! category, along with the area of the resulting ridge. 
    12711271 
    12721272      DO jl1 = 1, jpl !jl1 describes the ridging category 
    12731273 
    1274       !------------------------------------------------ 
    1275       ! 3.1) Identify grid cells with nonzero ridging 
    1276       !------------------------------------------------ 
     1274         !------------------------------------------------ 
     1275         ! 3.1) Identify grid cells with nonzero ridging 
     1276         !------------------------------------------------ 
    12771277 
    12781278         icells = 0 
    … …  
    12801280            DO ji = 1, jpi 
    12811281               IF (aicen_init(ji,jj,jl1) .GT. epsi11 .AND. athorn(ji,jj,jl1) .GT. 0.0       & 
    1282                     .AND. closing_gross(ji,jj) > 0.0) THEN 
     1282                  .AND. closing_gross(ji,jj) > 0.0) THEN 
    12831283                  icells = icells + 1 
    12841284                  indxi(icells) = ji 
    … …  
    12961296            jj = indxj(ij) 
    12971297 
    1298       !-------------------------------------------------------------------- 
    1299       ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2) 
    1300       !-------------------------------------------------------------------- 
     1298            !-------------------------------------------------------------------- 
     1299            ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2) 
     1300            !-------------------------------------------------------------------- 
    13011301 
    13021302            ardg1(ji,jj) = aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice 
    … …  
    13101310            oirft2(ji,jj)= oirft1(ji,jj) / kraft 
    13111311 
    1312       !--------------------------------------------------------------- 
    1313       ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1  
    1314       !--------------------------------------------------------------- 
     1312            !--------------------------------------------------------------- 
     1313            ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1  
     1314            !--------------------------------------------------------------- 
    13151315 
    13161316            afrac(ji,jj) = ardg1(ji,jj) / aicen_init(ji,jj,jl1) !ridging 
    … …  
    13281328            ENDIF 
    13291329 
    1330       !-------------------------------------------------------------------------- 
    1331       ! 3.4) Subtract area, volume, and energy from ridging  
    1332       !     / rafting category n1. 
    1333       !-------------------------------------------------------------------------- 
     1330            !-------------------------------------------------------------------------- 
     1331            ! 3.4) Subtract area, volume, and energy from ridging  
     1332            !     / rafting category n1. 
     1333            !-------------------------------------------------------------------------- 
    13341334            vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) /             & 
    1335                            ( 1.0 + ridge_por ) 
     1335               ( 1.0 + ridge_por ) 
    13361336            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por ) 
    13371337            vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por 
    … …  
    13401340            esrdg(ji,jj) = esnon_init(ji,jj,jl1) * afrac(ji,jj) 
    13411341            srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) /            & 
    1342                             ( 1. + ridge_por ) 
     1342               ( 1. + ridge_por ) 
    13431343            srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
    13441344 
    … …  
    13571357            smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1(ji,jj)  - smrft(ji,jj) 
    13581358 
    1359       !----------------------------------------------------------------- 
    1360       ! 3.5) Compute properties of new ridges 
    1361       !----------------------------------------------------------------- 
     1359            !----------------------------------------------------------------- 
     1360            ! 3.5) Compute properties of new ridges 
     1361            !----------------------------------------------------------------- 
    13621362            !------------- 
    13631363            ! Salinity 
    … …  
    13731373            ! salt flux due to ridge creation 
    13741374            fsalt_rpo(ji,jj)  = fsalt_rpo(ji,jj) + &  
    1375             MAX ( zdummy - srdg2(ji,jj) , 0.0 )    & 
    1376             * rhoic / rdt_ice 
     1375               MAX ( zdummy - srdg2(ji,jj) , 0.0 )    & 
     1376               * rhoic / rdt_ice 
    13771377 
    13781378            ! sal times volume for new ridges 
    13791379            srdg2(ji,jj)      = sm_newridge * vrdg2(ji,jj)  
    13801380 
    1381       !------------------------------------             
    1382       ! 3.6 Increment ridging diagnostics 
    1383       !------------------------------------             
    1384  
    1385 !        jl1 looping 1-jpl 
    1386 !           ij looping 1-icells 
     1381            !------------------------------------             
     1382            ! 3.6 Increment ridging diagnostics 
     1383            !------------------------------------             
     1384 
     1385            !        jl1 looping 1-jpl 
     1386            !           ij looping 1-icells 
    13871387 
    13881388            dardg1dt(ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj) 
    … …  
    13931393            IF (con_i) vice_init(ji,jj) = vice_init(ji,jj) + vrdg2(ji,jj) - vrdg1(ji,jj) 
    13941394 
    1395       !------------------------------------------             
    1396       ! 3.7 Put the snow somewhere in the ocean 
    1397       !------------------------------------------             
    1398  
    1399 !  Place part of the snow lost by ridging into the ocean.  
    1400 !  Note that esnow_mlt < 0; the ocean must cool to melt snow. 
    1401 !  If the ocean temp = Tf already, new ice must grow. 
    1402 !  During the next time step, thermo_rates will determine whether 
    1403 !  the ocean cools or new ice grows. 
    1404 !        jl1 looping 1-jpl 
    1405 !           ij looping 1-icells 
    1406                 
     1395            !------------------------------------------             
     1396            ! 3.7 Put the snow somewhere in the ocean 
     1397            !------------------------------------------             
     1398 
     1399            !  Place part of the snow lost by ridging into the ocean.  
     1400            !  Note that esnow_mlt < 0; the ocean must cool to melt snow. 
     1401            !  If the ocean temp = Tf already, new ice must grow. 
     1402            !  During the next time step, thermo_rates will determine whether 
     1403            !  the ocean cools or new ice grows. 
     1404            !        jl1 looping 1-jpl 
     1405            !           ij looping 1-icells 
     1406 
    14071407            msnow_mlt(ji,jj) = msnow_mlt(ji,jj)                  & 
    1408                            + rhosn*vsrdg(ji,jj)*(1.0-fsnowrdg)   & 
    1409                            !rafting included 
    1410                            + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 
     1408               + rhosn*vsrdg(ji,jj)*(1.0-fsnowrdg)   & 
     1409                                !rafting included 
     1410               + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 
    14111411 
    14121412            esnow_mlt(ji,jj) = esnow_mlt(ji,jj)                  & 
    1413                            + esrdg(ji,jj)*(1.0-fsnowrdg)         & 
    1414                            !rafting included 
    1415                            + esrft(ji,jj)*(1.0-fsnowrft)           
    1416  
    1417       !----------------------------------------------------------------- 
    1418       ! 3.8 Compute quantities used to apportion ice among categories 
    1419       ! in the n2 loop below 
    1420       !----------------------------------------------------------------- 
    1421  
    1422 !        jl1 looping 1-jpl 
    1423 !           ij looping 1-icells 
     1413               + esrdg(ji,jj)*(1.0-fsnowrdg)         & 
     1414                                !rafting included 
     1415               + esrft(ji,jj)*(1.0-fsnowrft)           
     1416 
     1417            !----------------------------------------------------------------- 
     1418            ! 3.8 Compute quantities used to apportion ice among categories 
     1419            ! in the n2 loop below 
     1420            !----------------------------------------------------------------- 
     1421 
     1422            !        jl1 looping 1-jpl 
     1423            !           ij looping 1-icells 
    14241424 
    14251425            dhr(ji,jj)  = hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) 
    14261426            dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1)    & 
    1427                       - hrmin(ji,jj,jl1)   * hrmin(ji,jj,jl1) 
     1427               - hrmin(ji,jj,jl1)   * hrmin(ji,jj,jl1) 
    14281428 
    14291429 
    14301430         END DO                 ! ij 
    14311431 
    1432       !-------------------------------------------------------------------- 
    1433       ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and 
    1434       !      compute ridged ice enthalpy  
    1435       !-------------------------------------------------------------------- 
     1432         !-------------------------------------------------------------------- 
     1433         ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and 
     1434         !      compute ridged ice enthalpy  
     1435         !-------------------------------------------------------------------- 
    14361436         DO jk = 1, nlay_i 
    14371437!CDIR NODEP 
    14381438            DO ij = 1, icells 
    1439             ji = indxi(ij) 
    1440             jj = indxj(ij) 
    1441             ! heat content of ridged ice 
    1442             erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / &  
    1443                                    ( 1.0 + ridge_por )  
    1444             eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 
    1445             e_i(ji,jj,jk,jl1)    = e_i(ji,jj,jk,jl1)             & 
    1446                                         - erdg1(ji,jj,jk)        & 
    1447                                         - eirft(ji,jj,jk) 
    1448             ! sea water heat content 
    1449             ztmelts          = - tmut * sss_m(ji,jj) + rtt 
    1450             ! heat content per unit volume 
    1451             zdummy0          = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj) 
    1452  
    1453             ! corrected sea water salinity 
    1454             zindb  = MAX( 0.0, SIGN( 1.0, vsw(ji,jj) - zeps ) ) 
    1455             zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / & 
    1456                      MAX( ridge_por * vsw(ji,jj), zeps ) 
    1457  
    1458             ztmelts          = - tmut * zdummy + rtt 
    1459             ersw(ji,jj,jk)   = - rcp * ( ztmelts - rtt ) * vsw(ji,jj) 
    1460  
    1461             ! heat flux 
    1462             fheat_rpo(ji,jj) = fheat_rpo(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) / & 
    1463                                      rdt_ice 
    1464  
    1465             ! Correct dimensions to avoid big values 
    1466             ersw(ji,jj,jk)   = ersw(ji,jj,jk) / 1.0d+09 
    1467  
    1468             ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    1469             ersw(ji,jj,jk)   = ersw(ji,jj,jk) * & 
    1470                                area(ji,jj) * vsw(ji,jj) / & 
    1471                                nlay_i 
    1472  
    1473             erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
     1439               ji = indxi(ij) 
     1440               jj = indxj(ij) 
     1441               ! heat content of ridged ice 
     1442               erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / &  
     1443                  ( 1.0 + ridge_por )  
     1444               eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 
     1445               e_i(ji,jj,jk,jl1)    = e_i(ji,jj,jk,jl1)             & 
     1446                  - erdg1(ji,jj,jk)        & 
     1447                  - eirft(ji,jj,jk) 
     1448               ! sea water heat content 
     1449               ztmelts          = - tmut * sss_m(ji,jj) + rtt 
     1450               ! heat content per unit volume 
     1451               zdummy0          = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj) 
     1452 
     1453               ! corrected sea water salinity 
     1454               zindb  = MAX( 0.0, SIGN( 1.0, vsw(ji,jj) - zeps ) ) 
     1455               zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / & 
     1456                  MAX( ridge_por * vsw(ji,jj), zeps ) 
     1457 
     1458               ztmelts          = - tmut * zdummy + rtt 
     1459               ersw(ji,jj,jk)   = - rcp * ( ztmelts - rtt ) * vsw(ji,jj) 
     1460 
     1461               ! heat flux 
     1462               fheat_rpo(ji,jj) = fheat_rpo(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) / & 
     1463                  rdt_ice 
     1464 
     1465               ! Correct dimensions to avoid big values 
     1466               ersw(ji,jj,jk)   = ersw(ji,jj,jk) / 1.0d+09 
     1467 
     1468               ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
     1469               ersw(ji,jj,jk)   = ersw(ji,jj,jk) * & 
     1470                  area(ji,jj) * vsw(ji,jj) / & 
     1471                  nlay_i 
     1472 
     1473               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
    14741474            END DO ! ij 
    14751475         END DO !jk 
    … …  
    14831483                  jj = indxj(ij) 
    14841484                  eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - & 
    1485                   erdg1(ji,jj,jk) 
     1485                     erdg1(ji,jj,jk) 
    14861486               END DO ! ij 
    14871487            END DO !jk 
    … …  
    14971497                  WRITE(numout,*) ' ardg > a_i' 
    14981498                  WRITE(numout,*) ' ardg, aicen_init : ', & 
    1499                        ardg1(ji,jj), aicen_init(ji,jj,jl1) 
     1499                     ardg1(ji,jj), aicen_init(ji,jj,jl1) 
    15001500               ENDIF            ! afrac > 1 + puny 
    15011501            ENDDO               ! if 
    … …  
    15101510                  WRITE(numout,*) ' arft > a_i' 
    15111511                  WRITE(numout,*) ' arft, aicen_init : ', & 
    1512                        arft1(ji,jj), aicen_init(ji,jj,jl1) 
     1512                     arft1(ji,jj), aicen_init(ji,jj,jl1) 
    15131513               ENDIF            ! afrft > 1 + puny 
    15141514            ENDDO               ! if 
    15151515         ENDIF                  ! large_afrft 
    15161516 
    1517 !------------------------------------------------------------------------------- 
    1518 ! 4) Add area, volume, and energy of new ridge to each category jl2 
    1519 !------------------------------------------------------------------------------- 
    1520 !        jl1 looping 1-jpl 
     1517         !------------------------------------------------------------------------------- 
     1518         ! 4) Add area, volume, and energy of new ridge to each category jl2 
     1519         !------------------------------------------------------------------------------- 
     1520         !        jl1 looping 1-jpl 
    15211521         DO jl2  = ice_cat_bounds(1,1), ice_cat_bounds(1,2)  
    1522          ! over categories to which ridged ice is transferred 
     1522            ! over categories to which ridged ice is transferred 
    15231523!CDIR NODEP 
    15241524            DO ij = 1, icells 
    … …  
    15311531 
    15321532               IF (hrmin(ji,jj,jl1) .GE. hi_max(jl2) .OR.        & 
    1533                    hrmax(ji,jj,jl1) .LE. hi_max(jl2-1)) THEN 
     1533                  hrmax(ji,jj,jl1) .LE. hi_max(jl2-1)) THEN 
    15341534                  hL = 0.0 
    15351535                  hR = 0.0 
    … …  
    15461546               v_i(ji,jj,jl2)    = v_i(ji,jj,jl2) + fvol(ji,jj) * vrdg2(ji,jj) 
    15471547               v_s(ji,jj,jl2)    = v_s(ji,jj,jl2)                             & 
    1548                                  + fvol(ji,jj) * vsrdg(ji,jj) * fsnowrdg 
     1548                  + fvol(ji,jj) * vsrdg(ji,jj) * fsnowrdg 
    15491549               e_s(ji,jj,1,jl2)  = e_s(ji,jj,1,jl2)                           & 
    1550                                  + fvol(ji,jj) * esrdg(ji,jj) * fsnowrdg 
     1550                  + fvol(ji,jj) * esrdg(ji,jj) * fsnowrdg 
    15511551               smv_i(ji,jj,jl2)  = smv_i(ji,jj,jl2) + fvol(ji,jj) * srdg2(ji,jj) 
    15521552               oa_i(ji,jj,jl2)   = oa_i(ji,jj,jl2)  + farea * oirdg2(ji,jj) 
    … …  
    15611561                  jj = indxj(ij) 
    15621562                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2)          & 
    1563                                     + fvol(ji,jj)*erdg2(ji,jj,jk) 
     1563                     + fvol(ji,jj)*erdg2(ji,jj,jk) 
    15641564               END DO           ! ij 
    15651565            END DO !jk 
    … …  
    15761576               ! Compute the fraction of rafted ice area and volume going to  
    15771577               ! thickness category jl2, transfer area, volume, and energy accordingly. 
    1578              
     1578 
    15791579               IF (hraft(ji,jj,jl1) .LE. hi_max(jl2) .AND.        & 
    1580                    hraft(ji,jj,jl1) .GT. hi_max(jl2-1)) THEN 
     1580                  hraft(ji,jj,jl1) .GT. hi_max(jl2-1)) THEN 
    15811581                  a_i(ji,jj,jl2) = a_i(ji,jj,jl2) + arft2(ji,jj) 
    15821582                  v_i(ji,jj,jl2) = v_i(ji,jj,jl2) + virft(ji,jj) 
    15831583                  v_s(ji,jj,jl2) = v_s(ji,jj,jl2)                   & 
    1584                                  + vsrft(ji,jj)*fsnowrft 
     1584                     + vsrft(ji,jj)*fsnowrft 
    15851585                  e_s(ji,jj,1,jl2) = e_s(ji,jj,1,jl2)                   & 
    1586                                  + esrft(ji,jj)*fsnowrft 
     1586                     + esrft(ji,jj)*fsnowrft 
    15871587                  smv_i(ji,jj,jl2) = smv_i(ji,jj,jl2)                 & 
    1588                                  + smrft(ji,jj)     
     1588                     + smrft(ji,jj)     
    15891589                  oa_i(ji,jj,jl2)  = oa_i(ji,jj,jl2)                  & 
    1590                                    + oirft2(ji,jj)     
     1590                     + oirft2(ji,jj)     
    15911591               ENDIF ! hraft 
    15921592 
    … …  
    16001600                  jj = indxj(ij) 
    16011601                  IF (hraft(ji,jj,jl1) .LE. hi_max(jl2) .AND.        & 
    1602                       hraft(ji,jj,jl1) .GT. hi_max(jl2-1)) THEN 
     1602                     hraft(ji,jj,jl1) .GT. hi_max(jl2-1)) THEN 
    16031603                     e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2)             & 
    1604                                        + eirft(ji,jj,jk) 
     1604                        + eirft(ji,jj,jk) 
    16051605                  ENDIF 
    16061606               END DO           ! ij 
    … …  
    16281628   END SUBROUTINE lim_itd_me_ridgeshift 
    16291629 
    1630 !============================================================================== 
     1630   !============================================================================== 
    16311631 
    16321632   SUBROUTINE lim_itd_me_asumr !(subroutine 5/6) 
    16331633 
    1634         !!----------------------------------------------------------------------------- 
    1635         !!                ***  ROUTINE lim_itd_me_asumr *** 
    1636         !! ** Purpose : 
    1637         !!        This routine finds total fractional area 
    1638         !! 
    1639         !! ** Method  : 
    1640         !! Find the total area of ice plus open water in each grid cell. 
    1641         !! 
    1642         !! This is similar to the aggregate_area subroutine except that the 
    1643         !! total area can be greater than 1, so the open water area is  
    1644         !! included in the sum instead of being computed as a residual.  
    1645         !! 
    1646         !! ** Arguments : 
     1634      !!----------------------------------------------------------------------------- 
     1635      !!                ***  ROUTINE lim_itd_me_asumr *** 
     1636      !! ** Purpose : 
     1637      !!        This routine finds total fractional area 
     1638      !! 
     1639      !! ** Method  : 
     1640      !! Find the total area of ice plus open water in each grid cell. 
     1641      !! 
     1642      !! This is similar to the aggregate_area subroutine except that the 
     1643      !! total area can be greater than 1, so the open water area is  
     1644      !! included in the sum instead of being computed as a residual.  
     1645      !! 
     1646      !! ** Arguments : 
    16471647 
    16481648      INTEGER :: ji, jj, jl 
    … …  
    16721672   END SUBROUTINE lim_itd_me_asumr 
    16731673 
    1674 !============================================================================== 
     1674   !============================================================================== 
    16751675 
    16761676   SUBROUTINE lim_itd_me_init ! (subroutine 6/6) 
    … …  
    16911691      !!------------------------------------------------------------------- 
    16921692      NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,&  
    1693                             Gstar, astar,                                & 
    1694                             Hstar, raftswi, hparmeter, Craft, ridge_por, & 
    1695                             sal_max_ridge,  partfun_swi, transfun_swi,   & 
    1696                             brinstren_swi 
     1693         Gstar, astar,                                & 
     1694         Hstar, raftswi, hparmeter, Craft, ridge_por, & 
     1695         sal_max_ridge,  partfun_swi, transfun_swi,   & 
     1696         brinstren_swi 
    16971697      !!------------------------------------------------------------------- 
    16981698 
    … …  
    17251725   END SUBROUTINE lim_itd_me_init 
    17261726 
    1727 !============================================================================== 
     1727   !============================================================================== 
    17281728 
    17291729   SUBROUTINE lim_itd_me_zapsmall 
    … …  
    17431743 
    17441744      INTEGER ::   & 
    1745            ji,jj,  & ! horizontal indices 
    1746            jl,     & ! ice category index 
    1747            jk,     & ! ice layer index 
    1748 !           ij,     &   ! combined i/j horizontal index 
    1749            icells      ! number of cells with ice to zap 
    1750  
    1751 !      INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 
    1752 !           indxi,  & ! compressed indices for i/j directions 
    1753 !           indxj 
     1745         ji,jj,  & ! horizontal indices 
     1746         jl,     & ! ice category index 
     1747         jk,     & ! ice layer index 
     1748         !           ij,     &   ! combined i/j horizontal index 
     1749         icells      ! number of cells with ice to zap 
     1750 
     1751      !      INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 
     1752      !           indxi,  & ! compressed indices for i/j directions 
     1753      !           indxj 
    17541754 
    17551755      INTEGER, DIMENSION(jpi,jpj) :: zmask 
    … …  
    17571757 
    17581758      REAL(wp) :: & 
    1759            xtmp      ! temporary variable 
     1759         xtmp      ! temporary variable 
    17601760 
    17611761      DO jl = 1, jpl 
    17621762 
    1763       !----------------------------------------------------------------- 
    1764       ! Count categories to be zapped. 
    1765       ! Abort model in case of negative area. 
    1766       !----------------------------------------------------------------- 
    1767          IF( MINVAL(a_i(:,:,jl)) .LT. -epsi11 ) THEN 
     1763         !----------------------------------------------------------------- 
     1764         ! Count categories to be zapped. 
     1765         ! Abort model in case of negative area. 
     1766         !----------------------------------------------------------------- 
     1767         IF( MINVAL(a_i(:,:,jl)) .LT. -epsi11 .AND. ln_nicep ) THEN 
    17681768            DO jj = 1, jpj 
    17691769               DO ji = 1, jpi 
    … …  
    17741774                  ENDIF 
    17751775               END DO 
    1776             END DO  
     1776            END DO 
    17771777         ENDIF 
    1778   
    1779        icells = 0 
    1780        zmask = 0.e0 
    1781        DO jj = 1, jpj 
    1782          DO ji = 1, jpi 
    1783             IF ( ( a_i(ji,jj,jl) .GE. -epsi11 .AND. a_i(ji,jj,jl) .LT. 0.0)       & 
    1784                                          .OR.                                         & 
    1785                      ( a_i(ji,jj,jl) .GT. 0.0     .AND. a_i(ji,jj,jl) .LE. 1.0e-11 )  & 
    1786                                          .OR.                                         & 
    1787                                          !new line 
    1788                      ( v_i(ji,jj,jl) .EQ. 0.0     .AND. a_i(ji,jj,jl) .GT. 0.0    )   & 
    1789                                          .OR.                                         & 
    1790                      ( v_i(ji,jj,jl) .GT. 0.0     .AND. v_i(ji,jj,jl) .LT. 1.e-12 ) ) THEN 
    1791                 zmask(ji,jj) = 1 
    1792             ENDIF 
     1778 
     1779         icells = 0 
     1780         zmask = 0.e0 
     1781         DO jj = 1, jpj 
     1782            DO ji = 1, jpi 
     1783               IF ( ( a_i(ji,jj,jl) .GE. -epsi11 .AND. a_i(ji,jj,jl) .LT. 0.0)       & 
     1784                  .OR.                                         & 
     1785                  ( a_i(ji,jj,jl) .GT. 0.0     .AND. a_i(ji,jj,jl) .LE. 1.0e-11 )  & 
     1786                  .OR.                                         & 
     1787                                !new line 
     1788                  ( v_i(ji,jj,jl) .EQ. 0.0     .AND. a_i(ji,jj,jl) .GT. 0.0    )   & 
     1789                  .OR.                                         & 
     1790                  ( v_i(ji,jj,jl) .GT. 0.0     .AND. v_i(ji,jj,jl) .LT. 1.e-12 ) ) THEN 
     1791                  zmask(ji,jj) = 1 
     1792               ENDIF 
     1793            END DO 
    17931794         END DO 
    1794          END DO 
    1795          WRITE(numout,*) SUM(zmask), ' cells of ice zapped in the ocean ' 
    1796  
    1797       !----------------------------------------------------------------- 
    1798       ! Zap ice energy and use ocean heat to melt ice 
    1799       !----------------------------------------------------------------- 
     1795         IF( ln_nicep ) WRITE(numout,*) SUM(zmask), ' cells of ice zapped in the ocean ' 
     1796 
     1797         !----------------------------------------------------------------- 
     1798         ! Zap ice energy and use ocean heat to melt ice 
     1799         !----------------------------------------------------------------- 
    18001800 
    18011801         DO jk = 1, nlay_i 
    … …  
    18031803               DO ji = 1 , jpi 
    18041804 
    1805                xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) / rdt_ice 
    1806                xtmp = xtmp * unit_fac 
    1807 !              fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
    1808                e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1 - zmask(ji,jj) ) 
     1805                  xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) / rdt_ice 
     1806                  xtmp = xtmp * unit_fac 
     1807                  !              fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
     1808                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1 - zmask(ji,jj) ) 
    18091809               END DO           ! ji 
    18101810            END DO           ! jj 
    … …  
    18141814            DO ji = 1 , jpi 
    18151815 
    1816       !----------------------------------------------------------------- 
    1817       ! Zap snow energy and use ocean heat to melt snow 
    1818       !----------------------------------------------------------------- 
    1819  
    1820 !           xtmp = esnon(i,j,n) / dt ! < 0 
    1821 !           fhnet(i,j)      = fhnet(i,j)      + xtmp 
    1822 !           fhnet_hist(i,j) = fhnet_hist(i,j) + xtmp 
    1823             ! xtmp is greater than 0 
    1824             ! fluxes are positive to the ocean 
    1825             ! here the flux has to be negative for the ocean 
    1826             xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice 
    1827 !           fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
    1828  
    1829             xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice !RB   ??????? 
    1830  
    1831             t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1 - zmask(ji,jj) ) 
    1832  
    1833       !----------------------------------------------------------------- 
    1834       ! zap ice and snow volume, add water and salt to ocean 
    1835       !----------------------------------------------------------------- 
    1836  
    1837 !           xtmp = (rhoi*vicen(i,j,n) + rhos*vsnon(i,j,n)) / dt 
    1838 !           fresh(i,j)      = fresh(i,j)      + xtmp 
    1839 !           fresh_hist(i,j) = fresh_hist(i,j) + xtmp 
    1840  
    1841 !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj)                  ) * &  
    1842 !                               rhosn * v_s(ji,jj,jl) / rdt_ice 
    1843  
    1844 !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * &  
    1845 !                               rhoic * v_i(ji,jj,jl) / rdt_ice 
    1846  
    1847 !           emps(i,j)      = emps(i,j)      + xtmp 
    1848 !           fsalt_hist(i,j) = fsalt_hist(i,j) + xtmp 
    1849  
    1850             ato_i(ji,jj)   = a_i(ji,jj,jl)  * zmask(ji,jj) + ato_i(ji,jj) 
    1851             a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 
    1852             v_i(ji,jj,jl)  = v_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 
    1853             v_s(ji,jj,jl)  = v_s(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 
    1854             t_su(ji,jj,jl) = t_su(ji,jj,jl) * (1 -zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj) 
    1855             oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 
    1856             smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 
     1816               !----------------------------------------------------------------- 
     1817               ! Zap snow energy and use ocean heat to melt snow 
     1818               !----------------------------------------------------------------- 
     1819 
     1820               !           xtmp = esnon(i,j,n) / dt ! < 0 
     1821               !           fhnet(i,j)      = fhnet(i,j)      + xtmp 
     1822               !           fhnet_hist(i,j) = fhnet_hist(i,j) + xtmp 
     1823               ! xtmp is greater than 0 
     1824               ! fluxes are positive to the ocean 
     1825               ! here the flux has to be negative for the ocean 
     1826               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice 
     1827               !           fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
     1828 
     1829               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice !RB   ??????? 
     1830 
     1831               t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1 - zmask(ji,jj) ) 
     1832 
     1833               !----------------------------------------------------------------- 
     1834               ! zap ice and snow volume, add water and salt to ocean 
     1835               !----------------------------------------------------------------- 
     1836 
     1837               !           xtmp = (rhoi*vicen(i,j,n) + rhos*vsnon(i,j,n)) / dt 
     1838               !           fresh(i,j)      = fresh(i,j)      + xtmp 
     1839               !           fresh_hist(i,j) = fresh_hist(i,j) + xtmp 
     1840 
     1841               !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj)                  ) * &  
     1842               !                               rhosn * v_s(ji,jj,jl) / rdt_ice 
     1843 
     1844               !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * &  
     1845               !                               rhoic * v_i(ji,jj,jl) / rdt_ice 
     1846 
     1847               !           emps(i,j)      = emps(i,j)      + xtmp 
     1848               !           fsalt_hist(i,j) = fsalt_hist(i,j) + xtmp 
     1849 
     1850               ato_i(ji,jj)   = a_i(ji,jj,jl)  * zmask(ji,jj) + ato_i(ji,jj) 
     1851               a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 
     1852               v_i(ji,jj,jl)  = v_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 
     1853               v_s(ji,jj,jl)  = v_s(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 
     1854               t_su(ji,jj,jl) = t_su(ji,jj,jl) * (1 -zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj) 
     1855               oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 
     1856               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1 - zmask(ji,jj) ) 
    18571857 
    18581858            END DO                 ! ji 

  • trunk/NEMO/LIM_SRC_3/limitd_th.F90

    r869 r921  
    2828   USE prtctl           ! Print control 
    2929   USE lib_mpp  
    30   
     30 
    3131   IMPLICIT NONE 
    3232   PRIVATE 
    … …  
    5151   !!---------------------------------------------------------------------- 
    5252 
    53 !!---------------------------------------------------------------------------------------------- 
    54 !!---------------------------------------------------------------------------------------------- 
     53   !!---------------------------------------------------------------------------------------------- 
     54   !!---------------------------------------------------------------------------------------------- 
    5555 
    5656CONTAINS 
    5757 
    58    SUBROUTINE lim_itd_th 
    59         !!------------------------------------------------------------------ 
    60         !!                ***  ROUTINE lim_itd_th *** 
    61         !! ** Purpose : 
    62         !!        This routine computes the thermodynamics of ice thickness 
    63         !!         distribution 
    64         !! ** Method  : 
    65         !! 
    66         !! ** Arguments : 
    67         !!           kideb , kiut : Starting and ending points on which the  
    68         !!                         the computation is applied 
    69         !! 
    70         !! ** Inputs / Ouputs : (global commons) 
    71         !! 
    72         !! ** External :  
    73         !! 
    74         !! ** References : 
    75         !! 
    76         !! ** History : 
    77         !!           (12-2005) Martin Vancoppenolle  
    78         !! 
    79         !!------------------------------------------------------------------ 
    80         !! * Arguments 
    81  
    82        !! * Local variables 
    83        INTEGER ::   jl, ja,   &   ! ice category, layers 
    84                     jm,       &   ! ice types    dummy loop index 
    85                     jbnd1,    & 
    86                     jbnd2 
    87  
    88        REAL(wp)  ::           &  ! constant values 
    89           zeps      =  1.0e-10, & 
    90           epsi10    =  1.0e-10 
    91  
    92 !!-- End of declarations 
    93 !!---------------------------------------------------------------------------------------------- 
    94  
    95        IF (lwp) THEN 
    96           WRITE(numout,*) 
    97           WRITE(numout,*) 'lim_itd_th  : Thermodynamics of the ice thickness distribution' 
    98           WRITE(numout,*) '~~~~~~~~~~~' 
    99        ENDIF 
    100  
    101 !------------------------------------------------------------------------------| 
    102 !  1) Transport of ice between thickness categories.                           | 
    103 !------------------------------------------------------------------------------| 
     58   SUBROUTINE lim_itd_th( kt ) 
     59      !!------------------------------------------------------------------ 
     60      !!                ***  ROUTINE lim_itd_th *** 
     61      !! ** Purpose : 
     62      !!        This routine computes the thermodynamics of ice thickness 
     63      !!         distribution 
     64      !! ** Method  : 
     65      !! 
     66      !! ** Arguments : 
     67      !!           kideb , kiut : Starting and ending points on which the  
     68      !!                         the computation is applied 
     69      !! 
     70      !! ** Inputs / Ouputs : (global commons) 
     71      !! 
     72      !! ** External :  
     73      !! 
     74      !! ** References : 
     75      !! 
     76      !! ** History : 
     77      !!           (12-2005) Martin Vancoppenolle  
     78      !! 
     79      !!------------------------------------------------------------------ 
     80      !! * Arguments 
     81      INTEGER, INTENT(in) :: kt 
     82      !! * Local variables 
     83      INTEGER ::   jl, ja,   &   ! ice category, layers 
     84         jm,       &   ! ice types    dummy loop index 
     85         jbnd1,    & 
     86         jbnd2 
     87 
     88      REAL(wp)  ::           &  ! constant values 
     89         zeps      =  1.0e-10, & 
     90         epsi10    =  1.0e-10 
     91 
     92      IF( kt == nit000 .AND. lwp ) THEN 
     93         WRITE(numout,*) 
     94         WRITE(numout,*) 'lim_itd_th  : Thermodynamics of the ice thickness distribution' 
     95         WRITE(numout,*) '~~~~~~~~~~~' 
     96      ENDIF 
     97 
     98      !------------------------------------------------------------------------------| 
     99      !  1) Transport of ice between thickness categories.                           | 
     100      !------------------------------------------------------------------------------| 
    104101      ! Given thermodynamic growth rates, transport ice between 
    105102      ! thickness categories. 
    … …  
    107104         jbnd1 = ice_cat_bounds(jm,1) 
    108105         jbnd2 = ice_cat_bounds(jm,2) 
    109          IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_rem(jbnd1, jbnd2, jm) 
     106         IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt ) 
    110107      END DO 
    111108 
    … …  
    113110      CALL lim_var_agg(1) 
    114111 
    115 !------------------------------------------------------------------------------| 
    116 !  3) Add frazil ice growing in leads. 
    117 !------------------------------------------------------------------------------| 
     112      !------------------------------------------------------------------------------| 
     113      !  3) Add frazil ice growing in leads. 
     114      !------------------------------------------------------------------------------| 
    118115 
    119116      CALL lim_thd_lac 
    120117      CALL lim_var_glo2eqv ! only for info 
    121118 
    122 !---------------------------------------------------------------------------------------- 
    123 !  4) Computation of trend terms and get back to old values       
    124 !---------------------------------------------------------------------------------------- 
     119      !---------------------------------------------------------------------------------------- 
     120      !  4) Computation of trend terms and get back to old values       
     121      !---------------------------------------------------------------------------------------- 
    125122 
    126123      !- Trend terms 
    … …  
    133130      d_smv_i_thd(:,:,:) = 0.0 
    134131      IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 
    135       d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
     132         d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
    136133 
    137134      IF(ln_ctl) THEN   ! Control print 
    … …  
    166163         END DO 
    167164      ENDIF 
    168        
     165 
    169166      !- Recover Old values 
    170167      a_i(:,:,:)         = old_a_i (:,:,:) 
    … …  
    175172 
    176173      IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 
    177       smv_i(:,:,:)       = old_smv_i (:,:,:) 
    178  
    179  
    180       END SUBROUTINE lim_itd_th 
    181  
    182 !!---------------------------------------------------------------------------------------------- 
    183 !!---------------------------------------------------------------------------------------------- 
    184  
    185     SUBROUTINE lim_itd_th_rem(klbnd,kubnd,ntyp) 
    186         !!------------------------------------------------------------------ 
    187         !!                ***  ROUTINE lim_itd_th_rem *** 
    188         !! ** Purpose : 
    189         !!        This routine computes the redistribution of ice thickness 
    190         !!        after thermodynamic growth of ice thickness 
    191         !! 
    192         !! ** Method  : Linear remapping  
    193         !! 
    194         !! ** Arguments : 
    195         !!           klbnd, kubnd : Starting and ending category index on which the  
    196         !!                         the computation is applied 
    197         !! 
    198         !! ** Inputs / Ouputs : (global commons) 
    199         !! 
    200         !! ** External :  
    201         !! 
    202         !! ** References : W.H. Lipscomb, JGR 2001 
    203         !! 
    204         !! ** History : 
    205         !!           largely inspired from CICE (c) W. H. Lipscomb and E.C. Hunke 
    206         !!  
    207         !!           (01-2006) Martin Vancoppenolle, UCL-ASTR, translation from 
    208         !!                     CICE 
    209         !!           (06-2006) Adaptation to include salt, age and types 
    210         !!           (04-2007) Mass conservation checked 
    211         !!------------------------------------------------------------------ 
    212         !! * Arguments 
    213  
    214        INTEGER , INTENT (IN) ::  & 
    215           klbnd ,  &  ! Start thickness category index point 
    216           kubnd ,  &  ! End point on which the  the computation is applied 
    217           ntyp        ! Number of the type used 
    218  
    219        !! * Local variables 
    220        INTEGER ::   ji,       &   ! spatial dummy loop index 
    221                     jj,       &   ! spatial dummy loop index 
    222                     jl,       &   ! ice category dummy loop index 
    223                     zji, zjj, &   ! dummy indices used when changing coordinates 
    224                     nd            ! used for thickness categories 
    225  
    226        INTEGER , DIMENSION(jpi,jpj,jpl-1) :: &  
    227                     zdonor        ! donor category index 
    228    
    229        REAL(wp)  ::           &   ! constant values 
    230           zeps      =  1.0e-10 
    231  
    232        REAL(wp)  ::           &  ! constant values for ice enthalpy 
    233           zindb     ,         & 
    234           zareamin  ,         &  ! minimum tolerated area in a thickness category 
    235           zwk1, zwk2,         &  ! all the following are dummy arguments 
    236           zx1, zx2, zx3,      &  ! 
    237           zetamin   ,         &  ! minimum value of eta 
    238           zetamax   ,         &  ! maximum value of eta 
    239           zdh0      ,         &  !  
    240           zda0      ,         &  ! 
    241           zdamax    ,         &  ! 
    242           zhimin 
    243  
    244        REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 
    245           zdhice           ,  &  ! ice thickness increment 
    246           g0               ,  &  ! coefficients for fitting the line of the ITD 
    247           g1               ,  &  ! coefficients for fitting the line of the ITD 
    248           hL               ,  &  ! left boundary for the ITD for each thickness 
    249           hR               ,  &  ! left boundary for the ITD for each thickness 
    250           zht_i_o          ,  &  ! old ice thickness 
    251           dummy_es 
    252  
    253        REAL(wp), DIMENSION(jpi,jpj,jpl-1) :: & 
    254           zdaice           ,  &  ! local increment of ice area  
    255           zdvice                 ! local increment of ice volume 
    256  
    257        REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: & 
    258           zhbnew                 ! new boundaries of ice categories 
    259  
    260        REAL(wp), DIMENSION(jpi,jpj) :: & 
    261           zhb0, zhb1             ! category boundaries for thinnes categories 
    262  
    263        REAL, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 
    264           zvetamin, zvetamax     ! maximum values for etas 
    265   
    266        INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 
    267           nind_i      ,  &  ! compressed indices for i/j directions 
    268           nind_j 
    269  
    270        INTEGER :: & 
    271           nbrem             ! number of cells with ice to transfer 
    272  
    273        LOGICAL, DIMENSION(jpi,jpj) ::   &  !: 
    274           zremap_flag             ! compute remapping or not ???? 
    275         
    276        REAL(wp)  ::           &  ! constant values for ice enthalpy 
    277           zslope                 ! used to compute local thermodynamic "speeds" 
    278  
    279        REAL (wp), DIMENSION(jpi,jpj) :: &  !  
    280                vt_i_init, vt_i_final,   &  !  ice volume summed over categories 
    281                vt_s_init, vt_s_final,   &  !  snow volume summed over categories 
    282                et_i_init, et_i_final,   &  !  ice energy summed over categories 
    283                et_s_init, et_s_final       !  snow energy summed over categories 
    284  
    285        CHARACTER (len = 15) :: fieldid 
    286         
    287 !!-- End of declarations 
    288 !!---------------------------------------------------------------------------------------------- 
     174         smv_i(:,:,:)       = old_smv_i (:,:,:) 
     175 
     176   END SUBROUTINE lim_itd_th 
     177   ! 
     178 
     179   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, ntyp, kt ) 
     180      !!------------------------------------------------------------------ 
     181      !!                ***  ROUTINE lim_itd_th_rem *** 
     182      !! ** Purpose : 
     183      !!        This routine computes the redistribution of ice thickness 
     184      !!        after thermodynamic growth of ice thickness 
     185      !! 
     186      !! ** Method  : Linear remapping  
     187      !! 
     188      !! ** Arguments : 
     189      !!           klbnd, kubnd : Starting and ending category index on which the  
     190      !!                         the computation is applied 
     191      !! 
     192      !! ** Inputs / Ouputs : (global commons) 
     193      !! 
     194      !! ** External :  
     195      !! 
     196      !! ** References : W.H. Lipscomb, JGR 2001 
     197      !! 
     198      !! ** History : 
     199      !!           largely inspired from CICE (c) W. H. Lipscomb and E.C. Hunke 
     200      !!  
     201      !!           (01-2006) Martin Vancoppenolle, UCL-ASTR, translation from 
     202      !!                     CICE 
     203      !!           (06-2006) Adaptation to include salt, age and types 
     204      !!           (04-2007) Mass conservation checked 
     205      !!------------------------------------------------------------------ 
     206      !! * Arguments 
     207 
     208      INTEGER , INTENT (IN) ::  & 
     209         klbnd ,  &  ! Start thickness category index point 
     210         kubnd ,  &  ! End point on which the  the computation is applied 
     211         ntyp  ,  &  ! Number of the type used 
     212         kt          ! Ocean time step  
     213 
     214      !! * Local variables 
     215      INTEGER ::   ji,       &   ! spatial dummy loop index 
     216         jj,       &   ! spatial dummy loop index 
     217         jl,       &   ! ice category dummy loop index 
     218         zji, zjj, &   ! dummy indices used when changing coordinates 
     219         nd            ! used for thickness categories 
     220 
     221      INTEGER , DIMENSION(jpi,jpj,jpl-1) :: &  
     222         zdonor        ! donor category index 
     223 
     224      REAL(wp)  ::           &   ! constant values 
     225         zeps      =  1.0e-10 
     226 
     227      REAL(wp)  ::           &  ! constant values for ice enthalpy 
     228         zindb     ,         & 
     229         zareamin  ,         &  ! minimum tolerated area in a thickness category 
     230         zwk1, zwk2,         &  ! all the following are dummy arguments 
     231         zx1, zx2, zx3,      &  ! 
     232         zetamin   ,         &  ! minimum value of eta 
     233         zetamax   ,         &  ! maximum value of eta 
     234         zdh0      ,         &  !  
     235         zda0      ,         &  ! 
     236         zdamax    ,         &  ! 
     237         zhimin 
     238 
     239      REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 
     240         zdhice           ,  &  ! ice thickness increment 
     241         g0               ,  &  ! coefficients for fitting the line of the ITD 
     242         g1               ,  &  ! coefficients for fitting the line of the ITD 
     243         hL               ,  &  ! left boundary for the ITD for each thickness 
     244         hR               ,  &  ! left boundary for the ITD for each thickness 
     245         zht_i_o          ,  &  ! old ice thickness 
     246         dummy_es 
     247 
     248      REAL(wp), DIMENSION(jpi,jpj,jpl-1) :: & 
     249         zdaice           ,  &  ! local increment of ice area  
     250         zdvice                 ! local increment of ice volume 
     251 
     252      REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: & 
     253         zhbnew                 ! new boundaries of ice categories 
     254 
     255      REAL(wp), DIMENSION(jpi,jpj) :: & 
     256         zhb0, zhb1             ! category boundaries for thinnes categories 
     257 
     258      REAL, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 
     259         zvetamin, zvetamax     ! maximum values for etas 
     260 
     261      INTEGER, DIMENSION(1:(jpi+1)*(jpj+1)) :: & 
     262         nind_i      ,  &  ! compressed indices for i/j directions 
     263         nind_j 
     264 
     265      INTEGER :: & 
     266         nbrem             ! number of cells with ice to transfer 
     267 
     268      LOGICAL, DIMENSION(jpi,jpj) ::   &  !: 
     269         zremap_flag             ! compute remapping or not ???? 
     270 
     271      REAL(wp)  ::           &  ! constant values for ice enthalpy 
     272         zslope                 ! used to compute local thermodynamic "speeds" 
     273 
     274      REAL (wp), DIMENSION(jpi,jpj) :: &  !  
     275         vt_i_init, vt_i_final,   &  !  ice volume summed over categories 
     276         vt_s_init, vt_s_final,   &  !  snow volume summed over categories 
     277         et_i_init, et_i_final,   &  !  ice energy summed over categories 
     278         et_s_init, et_s_final       !  snow energy summed over categories 
     279 
     280      CHARACTER (len = 15) :: fieldid 
     281 
     282      !!-- End of declarations 
     283      !!---------------------------------------------------------------------------------------------- 
    289284      zhimin = 0.1      !minimum ice thickness tolerated by the model 
    290285      zareamin = zeps   !minimum area in thickness categories tolerated by the conceptors of the model 
    291286 
    292 !!---------------------------------------------------------------------------------------------- 
    293 !! 0) Conservation checkand changes in each ice category 
    294 !!---------------------------------------------------------------------------------------------- 
     287      !!---------------------------------------------------------------------------------------------- 
     288      !! 0) Conservation checkand changes in each ice category 
     289      !!---------------------------------------------------------------------------------------------- 
    295290      IF ( con_i ) THEN 
    296291         CALL lim_column_sum (jpl,   v_i, vt_i_init) 
    … …  
    300295         CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_init) 
    301296      ENDIF 
    302   
    303 !!---------------------------------------------------------------------------------------------- 
    304 !! 1) Compute thickness and changes in each ice category 
    305 !!---------------------------------------------------------------------------------------------- 
    306        IF (lwp) THEN 
    307        WRITE(numout,*) 
    308        WRITE(numout,*) 'lim_itd_th_rem  : Remapping the ice thickness distribution' 
    309        WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    310        WRITE(numout,*) ' klbnd :       ', klbnd 
    311        WRITE(numout,*) ' kubnd :       ', kubnd 
    312        WRITE(numout,*) ' ntyp  :       ', ntyp  
    313        ENDIF 
    314  
    315        zdhice(:,:,:) = 0.0 
    316        DO jl = klbnd, kubnd 
    317           DO jj = 1, jpj 
    318              DO ji = 1, jpi 
    319                 zindb             = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl)))     !0 if no ice and 1 if yes 
    320                 ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX(a_i(ji,jj,jl),zeps) * zindb 
    321                 zindb             = 1.0-MAX(0.0,SIGN(1.0,-old_a_i(ji,jj,jl))) !0 if no ice and 1 if yes 
    322                 zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX(old_a_i(ji,jj,jl),zeps) * zindb 
    323                 IF (a_i(ji,jj,jl).gt.1e-6) THEN 
    324                    zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)  
    325                 ENDIF 
    326              END DO 
    327           END DO 
    328        END DO 
    329  
    330 !----------------------------------------------------------------------------------------------- 
    331 !  2) Compute fractional ice area in each grid cell 
    332 !----------------------------------------------------------------------------------------------- 
     297 
     298      !!---------------------------------------------------------------------------------------------- 
     299      !! 1) Compute thickness and changes in each ice category 
     300      !!---------------------------------------------------------------------------------------------- 
     301      IF (kt == nit000 .AND. lwp) THEN 
     302         WRITE(numout,*) 
     303         WRITE(numout,*) 'lim_itd_th_rem  : Remapping the ice thickness distribution' 
     304         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
     305         WRITE(numout,*) ' klbnd :       ', klbnd 
     306         WRITE(numout,*) ' kubnd :       ', kubnd 
     307         WRITE(numout,*) ' ntyp  :       ', ntyp  
     308      ENDIF 
     309 
     310      zdhice(:,:,:) = 0.0 
     311      DO jl = klbnd, kubnd 
     312         DO jj = 1, jpj 
     313            DO ji = 1, jpi 
     314               zindb             = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl)))     !0 if no ice and 1 if yes 
     315               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX(a_i(ji,jj,jl),zeps) * zindb 
     316               zindb             = 1.0-MAX(0.0,SIGN(1.0,-old_a_i(ji,jj,jl))) !0 if no ice and 1 if yes 
     317               zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX(old_a_i(ji,jj,jl),zeps) * zindb 
     318               IF (a_i(ji,jj,jl).gt.1e-6) THEN 
     319                  zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)  
     320               ENDIF 
     321            END DO 
     322         END DO 
     323      END DO 
     324 
     325      !----------------------------------------------------------------------------------------------- 
     326      !  2) Compute fractional ice area in each grid cell 
     327      !----------------------------------------------------------------------------------------------- 
    333328      at_i(:,:) = 0.0 
    334329      DO jl = klbnd, kubnd 
    … …  
    340335      END DO 
    341336 
    342 !----------------------------------------------------------------------------------------------- 
    343 !  3) Identify grid cells with ice 
    344 !----------------------------------------------------------------------------------------------- 
     337      !----------------------------------------------------------------------------------------------- 
     338      !  3) Identify grid cells with ice 
     339      !----------------------------------------------------------------------------------------------- 
    345340      nbrem = 0 
    346341      DO jj = 1, jpj 
    … …  
    357352      END DO !jj 
    358353 
    359 !----------------------------------------------------------------------------------------------- 
    360 !  4) Compute new category boundaries 
    361 !----------------------------------------------------------------------------------------------- 
     354      !----------------------------------------------------------------------------------------------- 
     355      !  4) Compute new category boundaries 
     356      !----------------------------------------------------------------------------------------------- 
    362357      !- 4.1 Compute category boundaries 
    363358      ! Tricky trick see limitd_me.F90 
    … …  
    374369            ! 
    375370            IF ( ( zht_i_o(zji,zjj,jl)  .GT.zeps ) .AND. &  
    376                  ( zht_i_o(zji,zjj,jl+1).GT.zeps ) ) THEN 
     371               ( zht_i_o(zji,zjj,jl+1).GT.zeps ) ) THEN 
    377372               !interpolate between adjacent category growth rates 
    378373               zslope = ( zdhice(zji,zjj,jl+1)     - zdhice(zji,zjj,jl) ) / & 
    379                         ( zht_i_o   (zji,zjj,jl+1) - zht_i_o   (zji,zjj,jl) ) 
     374                  ( zht_i_o   (zji,zjj,jl+1) - zht_i_o   (zji,zjj,jl) ) 
    380375               zhbnew(zji,zjj,jl) = hi_max(jl) + zdhice(zji,zjj,jl) + & 
    381                                     zslope * ( hi_max(jl) - zht_i_o(zji,zjj,jl) ) 
     376                  zslope * ( hi_max(jl) - zht_i_o(zji,zjj,jl) ) 
    382377            ELSEIF (zht_i_o(zji,zjj,jl).gt.zeps) THEN 
    383378               zhbnew(zji,zjj,jl) = hi_max(jl) + zdhice(zji,zjj,jl) 
    … …  
    391386         ! jl 
    392387 
    393       !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 
     388         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 
    394389         DO ji = 1, nbrem 
    395390            ! jl, ji 
    … …  
    398393            ! jl, ji 
    399394            IF ( ( a_i(zji,zjj,jl) .GT.zeps) .AND. &  
    400                  ( ht_i(zji,zjj,jl).GE. zhbnew(zji,zjj,jl) ) & 
     395               ( ht_i(zji,zjj,jl).GE. zhbnew(zji,zjj,jl) ) & 
    401396               ) THEN 
    402397               zremap_flag(zji,zjj) = .false. 
    403398            ELSEIF ( ( a_i(zji,zjj,jl+1) .GT. zeps ) .AND. & 
    404                      ( ht_i(zji,zjj,jl+1).LE. zhbnew(zji,zjj,jl) ) & 
    405                    ) THEN 
     399               ( ht_i(zji,zjj,jl+1).LE. zhbnew(zji,zjj,jl) ) & 
     400               ) THEN 
    406401               zremap_flag(zji,zjj) = .false. 
    407402            ENDIF 
    408403 
    409       !- 4.3 Check that each zhbnew does not exceed maximal values hi_max   
     404            !- 4.3 Check that each zhbnew does not exceed maximal values hi_max   
    410405            ! jl, ji 
    411406            IF (zhbnew(zji,zjj,jl).gt.hi_max(jl+1)) THEN 
    … …  
    420415         ! ji 
    421416      END DO !jl 
    422              
    423 !----------------------------------------------------------------------------------------------- 
    424 !  5) Identify cells where ITD is to be remapped 
    425 !----------------------------------------------------------------------------------------------- 
    426      nbrem = 0 
    427      DO jj = 1, jpj 
    428         DO ji = 1, jpi 
    429            IF ( zremap_flag(ji,jj) ) THEN 
    430               nbrem         = nbrem + 1 
    431               nind_i(nbrem) = ji 
    432               nind_j(nbrem) = jj 
    433            ENDIF 
    434         END DO !ji 
    435      END DO !jj 
    436  
    437 !----------------------------------------------------------------------------------------------- 
    438 !  6) Fill arrays with lowermost / uppermost boundaries of 'new' categories 
    439 !----------------------------------------------------------------------------------------------- 
    440      DO jj = 1, jpj 
    441         DO ji = 1, jpi 
    442            zhb0(ji,jj) = hi_max_typ(0,ntyp) ! 0eme 
    443            zhb1(ji,jj) = hi_max_typ(1,ntyp) ! 1er 
    444  
    445            zhbnew(ji,jj,klbnd-1) = 0.0 
    446             
    447            IF ( a_i(ji,jj,kubnd) .GT. zeps ) THEN 
    448               zhbnew(ji,jj,kubnd) = 3.0*ht_i(ji,jj,kubnd) - 2.0*zhbnew(ji,jj,kubnd-1) 
    449            ELSE 
    450               zhbnew(ji,jj,kubnd) = hi_max(kubnd) 
    451            ENDIF 
    452  
    453            IF ( zhbnew(ji,jj,kubnd) .LT. hi_max(kubnd-1) ) & 
    454               zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
    455  
    456         END DO !jj 
    457      END DO !jj 
    458  
    459 !----------------------------------------------------------------------------------------------- 
    460 !  7) Compute g(h)  
    461 !----------------------------------------------------------------------------------------------- 
    462      !- 7.1 g(h) for category 1 at start of time step 
    463      CALL lim_itd_fitline(klbnd, zhb0, zhb1, zht_i_o(:,:,klbnd), & 
    464                           g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd), & 
    465                           hR(:,:,klbnd), zremap_flag) 
    466  
    467      !- 7.2 Area lost due to melting of thin ice (first category,  klbnd) 
    468      DO ji = 1, nbrem 
    469         zji = nind_i(ji)  
    470         zjj = nind_j(ji)  
    471        
    472         !ji 
    473         IF (a_i(zji,zjj,klbnd) .gt. zeps) THEN 
    474            zdh0 = zdhice(zji,zjj,klbnd) !decrease of ice thickness in the lower category 
    475            ! ji, a_i > zeps 
    476            IF (zdh0 .lt. 0.0) THEN !remove area from category 1 
    477               ! ji, a_i > zeps; zdh0 < 0 
    478               zdh0 = MIN(-zdh0,hi_max(klbnd)) 
    479          
    480               !Integrate g(1) from 0 to dh0 to estimate area melted 
    481               zetamax = MIN(zdh0,hR(zji,zjj,klbnd)) - hL(zji,zjj,klbnd) 
    482               IF (zetamax.gt.0.0) THEN 
    483                  zx1  = zetamax 
    484                  zx2  = 0.5 * zetamax*zetamax  
    485                  zda0 = g1(zji,zjj,klbnd) * zx2 + g0(zji,zjj,klbnd) * zx1 !ice area removed 
    486               ! Constrain new thickness <= ht_i 
    487                  zdamax = a_i(zji,zjj,klbnd) * &  
    488                           (1.0 - ht_i(zji,zjj,klbnd)/zht_i_o(zji,zjj,klbnd)) ! zdamax > 0 
    489               !ice area lost due to melting of thin ice 
    490                  zda0   = MIN(zda0, zdamax) 
    491  
    492               ! Remove area, conserving volume 
    493                  ht_i(zji,zjj,klbnd) = ht_i(zji,zjj,klbnd) &  
    494                                * a_i(zji,zjj,klbnd) / ( a_i(zji,zjj,klbnd) - zda0 ) 
    495                  a_i(zji,zjj,klbnd)  = a_i(zji,zjj,klbnd) - zda0 
    496                  v_i(zji,zjj,klbnd)  = a_i(zji,zjj,klbnd)*ht_i(zji,zjj,klbnd) 
    497               ENDIF     ! zetamax > 0 
    498            ! ji, a_i > zeps 
    499  
    500            ELSE ! if ice accretion 
    501               ! ji, a_i > zeps; zdh0 > 0 
    502               IF ( ntyp .EQ. 1 ) zhbnew(zji,zjj,klbnd-1) = MIN(zdh0,hi_max(klbnd))  
    503               ! zhbnew was 0, and is shifted to the right to account for thin ice 
    504               ! growth in openwater (F0 = f1) 
    505               IF ( ntyp .NE. 1 ) zhbnew(zji,zjj,0) = 0  
    506               ! in other types there is 
    507               ! no open water growth (F0 = 0) 
    508            ENDIF ! zdh0  
    509  
    510            ! a_i > zeps 
    511         ENDIF ! a_i > zeps 
    512  
    513      END DO ! ji 
    514  
    515      !- 7.3 g(h) for each thickness category   
    516      DO jl = klbnd, kubnd 
    517         CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 
    518                              g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl),     & 
    519                              zremap_flag) 
    520      END DO 
    521  
    522 !----------------------------------------------------------------------------------------------- 
    523 !  8) Compute area and volume to be shifted across each boundary 
    524 !----------------------------------------------------------------------------------------------- 
    525  
    526      DO jl = klbnd, kubnd - 1 
    527         DO jj = 1, jpj 
    528            DO ji = 1, jpi 
    529               zdonor(ji,jj,jl) = 0 
    530               zdaice(ji,jj,jl) = 0.0 
    531               zdvice(ji,jj,jl) = 0.0 
    532            END DO 
    533         END DO 
    534  
    535         DO ji = 1, nbrem 
    536            zji = nind_i(ji) 
    537            zjj = nind_j(ji) 
    538             
    539            IF (zhbnew(zji,zjj,jl) .gt. hi_max(jl)) THEN ! transfer from jl to jl+1 
    540  
    541               ! left and right integration limits in eta space 
    542               zvetamin(ji) = MAX(hi_max(jl), hL(zji,zjj,jl)) - hL(zji,zjj,jl) 
    543               zvetamax(ji) = MIN(zhbnew(zji,zjj,jl), hR(zji,zjj,jl)) - hL(zji,zjj,jl) 
    544               zdonor(zji,zjj,jl) = jl 
    545  
    546            ELSE  ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 
    547  
    548               ! left and right integration limits in eta space 
    549               zvetamin(ji) = 0.0 
    550               zvetamax(ji) = MIN(hi_max(jl), hR(zji,zjj,jl+1)) - hL(zji,zjj,jl+1) 
    551               zdonor(zji,zjj,jl) = jl + 1 
    552  
    553            ENDIF  ! zhbnew(jl) > hi_max(jl) 
    554  
    555            zetamax = MAX(zvetamax(ji), zvetamin(ji)) ! no transfer if etamax < etamin 
    556            zetamin = zvetamin(ji) 
    557  
    558            zx1  = zetamax - zetamin 
    559            zwk1 = zetamin*zetamin 
    560            zwk2 = zetamax*zetamax 
    561            zx2  = 0.5 * (zwk2 - zwk1) 
    562            zwk1 = zwk1 * zetamin 
    563            zwk2 = zwk2 * zetamax 
    564            zx3  = 1.0/3.0 * (zwk2 - zwk1) 
    565            nd   = zdonor(zji,zjj,jl) 
    566            zdaice(zji,zjj,jl) = g1(zji,zjj,nd)*zx2 + g0(zji,zjj,nd)*zx1 
    567            zdvice(zji,zjj,jl) = g1(zji,zjj,nd)*zx3 + g0(zji,zjj,nd)*zx2 + & 
    568                               zdaice(zji,zjj,jl)*hL(zji,zjj,nd) 
    569  
    570         END DO ! ji 
    571      END DO ! jl klbnd -> kubnd - 1 
    572  
    573 !!---------------------------------------------------------------------------------------------- 
    574 !! 9) Shift ice between categories 
    575 !!---------------------------------------------------------------------------------------------- 
    576      CALL lim_itd_shiftice ( klbnd, kubnd, zdonor, zdaice, zdvice ) 
    577  
    578 !!---------------------------------------------------------------------------------------------- 
    579 !! 10) Make sure ht_i >= minimum ice thickness hi_min 
    580 !!---------------------------------------------------------------------------------------------- 
    581  
    582     DO ji = 1, nbrem 
    583         zji = nind_i(ji) 
    584         zjj = nind_j(ji) 
    585         IF ( ( zhimin .GT. 0.0 ) .AND. &  
    586              ( ( a_i(zji,zjj,1) .GT. zeps ) .AND. ( ht_i(zji,zjj,1) .LT. zhimin ) ) & 
    587            ) THEN 
    588            a_i(zji,zjj,1)  = a_i(zji,zjj,1) * ht_i(zji,zjj,1) / zhimin  
    589            ht_i(zji,zjj,1) = zhimin 
    590            v_i(zji,zjj,1)  = a_i(zji,zjj,1)*ht_i(zji,zjj,1) 
    591         ENDIF 
    592     END DO !ji 
    593  
    594 !!---------------------------------------------------------------------------------------------- 
    595 !! 11) Conservation check 
    596 !!---------------------------------------------------------------------------------------------- 
     417 
     418      !----------------------------------------------------------------------------------------------- 
     419      !  5) Identify cells where ITD is to be remapped 
     420      !----------------------------------------------------------------------------------------------- 
     421      nbrem = 0 
     422      DO jj = 1, jpj 
     423         DO ji = 1, jpi 
     424            IF ( zremap_flag(ji,jj) ) THEN 
     425               nbrem         = nbrem + 1 
     426               nind_i(nbrem) = ji 
     427               nind_j(nbrem) = jj 
     428            ENDIF 
     429         END DO !ji 
     430      END DO !jj 
     431 
     432      !----------------------------------------------------------------------------------------------- 
     433      !  6) Fill arrays with lowermost / uppermost boundaries of 'new' categories 
     434      !----------------------------------------------------------------------------------------------- 
     435      DO jj = 1, jpj 
     436         DO ji = 1, jpi 
     437            zhb0(ji,jj) = hi_max_typ(0,ntyp) ! 0eme 
     438            zhb1(ji,jj) = hi_max_typ(1,ntyp) ! 1er 
     439 
     440            zhbnew(ji,jj,klbnd-1) = 0.0 
     441 
     442            IF ( a_i(ji,jj,kubnd) .GT. zeps ) THEN 
     443               zhbnew(ji,jj,kubnd) = 3.0*ht_i(ji,jj,kubnd) - 2.0*zhbnew(ji,jj,kubnd-1) 
     444            ELSE 
     445               zhbnew(ji,jj,kubnd) = hi_max(kubnd) 
     446            ENDIF 
     447 
     448            IF ( zhbnew(ji,jj,kubnd) .LT. hi_max(kubnd-1) ) & 
     449               zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
     450 
     451         END DO !jj 
     452      END DO !jj 
     453 
     454      !----------------------------------------------------------------------------------------------- 
     455      !  7) Compute g(h)  
     456      !----------------------------------------------------------------------------------------------- 
     457      !- 7.1 g(h) for category 1 at start of time step 
     458      CALL lim_itd_fitline(klbnd, zhb0, zhb1, zht_i_o(:,:,klbnd), & 
     459         g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd), & 
     460         hR(:,:,klbnd), zremap_flag) 
     461 
     462      !- 7.2 Area lost due to melting of thin ice (first category,  klbnd) 
     463      DO ji = 1, nbrem 
     464         zji = nind_i(ji)  
     465         zjj = nind_j(ji)  
     466 
     467         !ji 
     468         IF (a_i(zji,zjj,klbnd) .gt. zeps) THEN 
     469            zdh0 = zdhice(zji,zjj,klbnd) !decrease of ice thickness in the lower category 
     470            ! ji, a_i > zeps 
     471            IF (zdh0 .lt. 0.0) THEN !remove area from category 1 
     472               ! ji, a_i > zeps; zdh0 < 0 
     473               zdh0 = MIN(-zdh0,hi_max(klbnd)) 
     474 
     475               !Integrate g(1) from 0 to dh0 to estimate area melted 
     476               zetamax = MIN(zdh0,hR(zji,zjj,klbnd)) - hL(zji,zjj,klbnd) 
     477               IF (zetamax.gt.0.0) THEN 
     478                  zx1  = zetamax 
     479                  zx2  = 0.5 * zetamax*zetamax  
     480                  zda0 = g1(zji,zjj,klbnd) * zx2 + g0(zji,zjj,klbnd) * zx1 !ice area removed 
     481                  ! Constrain new thickness <= ht_i 
     482                  zdamax = a_i(zji,zjj,klbnd) * &  
     483                     (1.0 - ht_i(zji,zjj,klbnd)/zht_i_o(zji,zjj,klbnd)) ! zdamax > 0 
     484                  !ice area lost due to melting of thin ice 
     485                  zda0   = MIN(zda0, zdamax) 
     486 
     487                  ! Remove area, conserving volume 
     488                  ht_i(zji,zjj,klbnd) = ht_i(zji,zjj,klbnd) &  
     489                     * a_i(zji,zjj,klbnd) / ( a_i(zji,zjj,klbnd) - zda0 ) 
     490                  a_i(zji,zjj,klbnd)  = a_i(zji,zjj,klbnd) - zda0 
     491                  v_i(zji,zjj,klbnd)  = a_i(zji,zjj,klbnd)*ht_i(zji,zjj,klbnd) 
     492               ENDIF     ! zetamax > 0 
     493               ! ji, a_i > zeps 
     494 
     495            ELSE ! if ice accretion 
     496               ! ji, a_i > zeps; zdh0 > 0 
     497               IF ( ntyp .EQ. 1 ) zhbnew(zji,zjj,klbnd-1) = MIN(zdh0,hi_max(klbnd))  
     498               ! zhbnew was 0, and is shifted to the right to account for thin ice 
     499               ! growth in openwater (F0 = f1) 
     500               IF ( ntyp .NE. 1 ) zhbnew(zji,zjj,0) = 0  
     501               ! in other types there is 
     502               ! no open water growth (F0 = 0) 
     503            ENDIF ! zdh0  
     504 
     505            ! a_i > zeps 
     506         ENDIF ! a_i > zeps 
     507 
     508      END DO ! ji 
     509 
     510      !- 7.3 g(h) for each thickness category   
     511      DO jl = klbnd, kubnd 
     512         CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 
     513            g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl),     & 
     514            zremap_flag) 
     515      END DO 
     516 
     517      !----------------------------------------------------------------------------------------------- 
     518      !  8) Compute area and volume to be shifted across each boundary 
     519      !----------------------------------------------------------------------------------------------- 
     520 
     521      DO jl = klbnd, kubnd - 1 
     522         DO jj = 1, jpj 
     523            DO ji = 1, jpi 
     524               zdonor(ji,jj,jl) = 0 
     525               zdaice(ji,jj,jl) = 0.0 
     526               zdvice(ji,jj,jl) = 0.0 
     527            END DO 
     528         END DO 
     529 
     530         DO ji = 1, nbrem 
     531            zji = nind_i(ji) 
     532            zjj = nind_j(ji) 
     533 
     534            IF (zhbnew(zji,zjj,jl) .gt. hi_max(jl)) THEN ! transfer from jl to jl+1 
     535 
     536               ! left and right integration limits in eta space 
     537               zvetamin(ji) = MAX(hi_max(jl), hL(zji,zjj,jl)) - hL(zji,zjj,jl) 
     538               zvetamax(ji) = MIN(zhbnew(zji,zjj,jl), hR(zji,zjj,jl)) - hL(zji,zjj,jl) 
     539               zdonor(zji,zjj,jl) = jl 
     540 
     541            ELSE  ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 
     542 
     543               ! left and right integration limits in eta space 
     544               zvetamin(ji) = 0.0 
     545               zvetamax(ji) = MIN(hi_max(jl), hR(zji,zjj,jl+1)) - hL(zji,zjj,jl+1) 
     546               zdonor(zji,zjj,jl) = jl + 1 
     547 
     548            ENDIF  ! zhbnew(jl) > hi_max(jl) 
     549 
     550            zetamax = MAX(zvetamax(ji), zvetamin(ji)) ! no transfer if etamax < etamin 
     551            zetamin = zvetamin(ji) 
     552 
     553            zx1  = zetamax - zetamin 
     554            zwk1 = zetamin*zetamin 
     555            zwk2 = zetamax*zetamax 
     556            zx2  = 0.5 * (zwk2 - zwk1) 
     557            zwk1 = zwk1 * zetamin 
     558            zwk2 = zwk2 * zetamax 
     559            zx3  = 1.0/3.0 * (zwk2 - zwk1) 
     560            nd   = zdonor(zji,zjj,jl) 
     561            zdaice(zji,zjj,jl) = g1(zji,zjj,nd)*zx2 + g0(zji,zjj,nd)*zx1 
     562            zdvice(zji,zjj,jl) = g1(zji,zjj,nd)*zx3 + g0(zji,zjj,nd)*zx2 + & 
     563               zdaice(zji,zjj,jl)*hL(zji,zjj,nd) 
     564 
     565         END DO ! ji 
     566      END DO ! jl klbnd -> kubnd - 1 
     567 
     568      !!---------------------------------------------------------------------------------------------- 
     569      !! 9) Shift ice between categories 
     570      !!---------------------------------------------------------------------------------------------- 
     571      CALL lim_itd_shiftice ( klbnd, kubnd, zdonor, zdaice, zdvice ) 
     572 
     573      !!---------------------------------------------------------------------------------------------- 
     574      !! 10) Make sure ht_i >= minimum ice thickness hi_min 
     575      !!---------------------------------------------------------------------------------------------- 
     576 
     577      DO ji = 1, nbrem 
     578         zji = nind_i(ji) 
     579         zjj = nind_j(ji) 
     580         IF ( ( zhimin .GT. 0.0 ) .AND. &  
     581            ( ( a_i(zji,zjj,1) .GT. zeps ) .AND. ( ht_i(zji,zjj,1) .LT. zhimin ) ) & 
     582            ) THEN 
     583            a_i(zji,zjj,1)  = a_i(zji,zjj,1) * ht_i(zji,zjj,1) / zhimin  
     584            ht_i(zji,zjj,1) = zhimin 
     585            v_i(zji,zjj,1)  = a_i(zji,zjj,1)*ht_i(zji,zjj,1) 
     586         ENDIF 
     587      END DO !ji 
     588 
     589      !!---------------------------------------------------------------------------------------------- 
     590      !! 11) Conservation check 
     591      !!---------------------------------------------------------------------------------------------- 
    597592      IF ( con_i ) THEN 
    598593         CALL lim_column_sum (jpl,   v_i, vt_i_final) 
    … …  
    614609      ENDIF 
    615610 
    616     END SUBROUTINE lim_itd_th_rem 
    617  
    618 !!---------------------------------------------------------------------------------------------- 
    619 !!---------------------------------------------------------------------------------------------- 
    620  
    621     SUBROUTINE lim_itd_fitline(num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag ) 
    622  
    623         !!------------------------------------------------------------------ 
    624         !!                ***  ROUTINE lim_itd_fitline *** 
    625         !! ** Purpose : 
    626         !! fit g(h) with a line using area, volume constraints 
    627         !! 
    628         !! ** Method  : 
    629         !! Fit g(h) with a line, satisfying area and volume constraints. 
    630         !! To reduce roundoff errors caused by large values of g0 and g1, 
    631         !! we actually compute g(eta), where eta = h - hL, and hL is the 
    632         !! left boundary. 
    633         !! 
    634         !! ** Arguments : 
    635         !! 
    636         !! ** Inputs / Ouputs : (global commons) 
    637         !! 
    638         !! ** External :  
    639         !! 
    640         !! ** References : 
    641         !! 
    642         !! ** History : 
    643         !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 
    644         !!          (01-2006) Martin Vancoppenolle  
    645         !! 
    646         !!------------------------------------------------------------------ 
    647         !! * Arguments 
     611   END SUBROUTINE lim_itd_th_rem 
     612   ! 
     613 
     614   SUBROUTINE lim_itd_fitline(num_cat, HbL, Hbr, hice, g0, g1, hL, hR, zremap_flag ) 
     615 
     616      !!------------------------------------------------------------------ 
     617      !!                ***  ROUTINE lim_itd_fitline *** 
     618      !! ** Purpose : 
     619      !! fit g(h) with a line using area, volume constraints 
     620      !! 
     621      !! ** Method  : 
     622      !! Fit g(h) with a line, satisfying area and volume constraints. 
     623      !! To reduce roundoff errors caused by large values of g0 and g1, 
     624      !! we actually compute g(eta), where eta = h - hL, and hL is the 
     625      !! left boundary. 
     626      !! 
     627      !! ** Arguments : 
     628      !! 
     629      !! ** Inputs / Ouputs : (global commons) 
     630      !! 
     631      !! ** External :  
     632      !! 
     633      !! ** References : 
     634      !! 
     635      !! ** History : 
     636      !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 
     637      !!          (01-2006) Martin Vancoppenolle  
     638      !! 
     639      !!------------------------------------------------------------------ 
     640      !! * Arguments 
    648641 
    649642      INTEGER, INTENT(in) :: num_cat      ! category index 
    … …  
    674667 
    675668      REAL(wp)  ::           &  ! constant values 
    676           zeps      =  1.0e-10 
     669         zeps      =  1.0e-10 
    677670 
    678671      zacrith       = 1.0e-6 
    679 !!-- End of declarations 
    680 !!---------------------------------------------------------------------------------------------- 
     672      !!-- End of declarations 
     673      !!---------------------------------------------------------------------------------------------- 
    681674 
    682675      DO jj = 1, jpj 
    … …  
    684677 
    685678            IF ( zremap_flag(ji,jj) .AND. a_i(ji,jj,num_cat) .gt. zacrith & 
    686                  .AND. hice(ji,jj) .GT. 0.0 ) THEN 
    687    
    688             ! Initialize hL and hR 
     679               .AND. hice(ji,jj) .GT. 0.0 ) THEN 
     680 
     681               ! Initialize hL and hR 
    689682 
    690683               hL(ji,jj) = HbL(ji,jj) 
    691684               hR(ji,jj) = HbR(ji,jj) 
    692685 
    693             ! Change hL or hR if hice falls outside central third of range 
     686               ! Change hL or hR if hice falls outside central third of range 
    694687 
    695688               zh13 = 1.0/3.0 * (2.0*hL(ji,jj) + hR(ji,jj)) 
    … …  
    702695               ENDIF 
    703696 
    704             ! Compute coefficients of g(eta) = g0 + g1*eta 
    705                    
     697               ! Compute coefficients of g(eta) = g0 + g1*eta 
     698 
    706699               zdhr = 1.0 / (hR(ji,jj) - hL(ji,jj)) 
    707700               zwk1 = 6.0 * a_i(ji,jj,num_cat) * zdhr 
    … …  
    722715      END DO ! jj 
    723716 
    724     END SUBROUTINE lim_itd_fitline 
    725  
    726 !---------------------------------------------------------------------------------------------- 
    727 !---------------------------------------------------------------------------------------------- 
    728  
    729     SUBROUTINE lim_itd_shiftice (klbnd, kubnd, zdonor, zdaice, zdvice) 
    730         !!------------------------------------------------------------------ 
    731         !!                ***  ROUTINE lim_itd_shiftice *** 
    732         !! ** Purpose : shift ice across category boundaries, conserving everything 
    733         !!              ( area, volume, energy, age*vol, and mass of salt ) 
    734         !! 
    735         !! ** Method  : 
    736         !! 
    737         !! ** Arguments : 
    738         !! 
    739         !! ** Inputs / Ouputs : (global commons) 
    740         !! 
    741         !! ** External :  
    742         !! 
    743         !! ** References : 
    744         !! 
    745         !! ** History : 
    746         !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 
    747         !!          (01-2006) Martin Vancoppenolle  
    748         !! 
    749         !!------------------------------------------------------------------ 
    750         !! * Arguments 
     717   END SUBROUTINE lim_itd_fitline 
     718   ! 
     719 
     720   SUBROUTINE lim_itd_shiftice (klbnd, kubnd, zdonor, zdaice, zdvice) 
     721      !!------------------------------------------------------------------ 
     722      !!                ***  ROUTINE lim_itd_shiftice *** 
     723      !! ** Purpose : shift ice across category boundaries, conserving everything 
     724      !!              ( area, volume, energy, age*vol, and mass of salt ) 
     725      !! 
     726      !! ** Method  : 
     727      !! 
     728      !! ** Arguments : 
     729      !! 
     730      !! ** Inputs / Ouputs : (global commons) 
     731      !! 
     732      !! ** External :  
     733      !! 
     734      !! ** References : 
     735      !! 
     736      !! ** History : 
     737      !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 
     738      !!          (01-2006) Martin Vancoppenolle  
     739      !! 
     740      !!------------------------------------------------------------------ 
     741      !! * Arguments 
    751742 
    752743      INTEGER , INTENT (IN) ::  & 
    753           klbnd ,  &  ! Start thickness category index point 
    754           kubnd       ! End point on which the  the computation is applied 
     744         klbnd ,  &  ! Start thickness category index point 
     745         kubnd       ! End point on which the  the computation is applied 
    755746 
    756747      INTEGER , DIMENSION(jpi,jpj,jpl-1), INTENT(IN) :: &  
    … …  
    792783 
    793784      LOGICAL :: & 
    794         zdaice_negative       , & ! true if daice < -puny 
    795         zdvice_negative       , & ! true if dvice < -puny 
    796         zdaice_greater_aicen  , & ! true if daice > aicen 
    797         zdvice_greater_vicen      ! true if dvice > vicen 
    798  
    799        REAL(wp)  ::           &  ! constant values 
    800           zeps      =  1.0e-10 
    801  
    802 !!-- End of declarations 
    803  
    804 !---------------------------------------------------------------------------------------------- 
    805 ! 1) Define a variable equal to a_i*T_su 
    806 !---------------------------------------------------------------------------------------------- 
     785         zdaice_negative       , & ! true if daice < -puny 
     786         zdvice_negative       , & ! true if dvice < -puny 
     787         zdaice_greater_aicen  , & ! true if daice > aicen 
     788         zdvice_greater_vicen      ! true if dvice > vicen 
     789 
     790      REAL(wp)  ::           &  ! constant values 
     791         zeps      =  1.0e-10 
     792 
     793      !!-- End of declarations 
     794 
     795      !---------------------------------------------------------------------------------------------- 
     796      ! 1) Define a variable equal to a_i*T_su 
     797      !---------------------------------------------------------------------------------------------- 
    807798 
    808799      DO jl = klbnd, kubnd 
    … …  
    814805      END DO ! jl 
    815806 
    816 !---------------------------------------------------------------------------------------------- 
    817 ! 2) Check for daice or dvice out of range, allowing for roundoff error 
    818 !---------------------------------------------------------------------------------------------- 
     807      !---------------------------------------------------------------------------------------------- 
     808      ! 2) Check for daice or dvice out of range, allowing for roundoff error 
     809      !---------------------------------------------------------------------------------------------- 
    819810      ! Note: zdaice < 0 or zdvice < 0 usually happens when category jl 
    820811      ! has a small area, with h(n) very close to a boundary.  Then 
    … …  
    834825            DO ji = 1, jpi 
    835826 
    836             IF (zdonor(ji,jj,jl) .GT. 0) THEN 
    837                jl1 = zdonor(ji,jj,jl) 
    838  
    839                IF (zdaice(ji,jj,jl) .LT. 0.0) THEN 
    840                   IF (zdaice(ji,jj,jl) .GT. -zeps) THEN 
    841                      IF ( ( jl1.EQ.jl   .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) )           & 
    842                                                 .OR.                                      & 
    843                           ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) )           &   
    844                         ) THEN                                                              
    845                         zdaice(ji,jj,jl) = a_i(ji,jj,jl1)  ! shift entire category 
    846                         zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
     827               IF (zdonor(ji,jj,jl) .GT. 0) THEN 
     828                  jl1 = zdonor(ji,jj,jl) 
     829 
     830                  IF (zdaice(ji,jj,jl) .LT. 0.0) THEN 
     831                     IF (zdaice(ji,jj,jl) .GT. -zeps) THEN 
     832                        IF ( ( jl1.EQ.jl   .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) )           & 
     833                           .OR.                                      & 
     834                           ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) )           &   
     835                           ) THEN                                                              
     836                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1)  ! shift entire category 
     837                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
     838                        ELSE 
     839                           zdaice(ji,jj,jl) = 0.0 ! shift no ice 
     840                           zdvice(ji,jj,jl) = 0.0 
     841                        ENDIF 
    847842                     ELSE 
    848                         zdaice(ji,jj,jl) = 0.0 ! shift no ice 
    849                         zdvice(ji,jj,jl) = 0.0 
     843                        zdaice_negative = .true. 
    850844                     ENDIF 
    851                   ELSE 
    852                      zdaice_negative = .true. 
    853845                  ENDIF 
    854                ENDIF 
    855  
    856                IF (zdvice(ji,jj,jl) .LT. 0.0) THEN 
    857                   IF (zdvice(ji,jj,jl) .GT. -zeps ) THEN 
    858                      IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1).GT.hi_max(jl) )     & 
    859                                        .OR.                                     & 
    860                           ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) ) & 
    861                         ) THEN 
    862                         zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category 
     846 
     847                  IF (zdvice(ji,jj,jl) .LT. 0.0) THEN 
     848                     IF (zdvice(ji,jj,jl) .GT. -zeps ) THEN 
     849                        IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1).GT.hi_max(jl) )     & 
     850                           .OR.                                     & 
     851                           ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) ) & 
     852                           ) THEN 
     853                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category 
     854                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
     855                        ELSE 
     856                           zdaice(ji,jj,jl) = 0.0    ! shift no ice 
     857                           zdvice(ji,jj,jl) = 0.0 
     858                        ENDIF 
     859                     ELSE 
     860                        zdvice_negative = .true. 
     861                     ENDIF 
     862                  ENDIF 
     863 
     864                  ! If daice is close to aicen, set daice = aicen. 
     865                  IF (zdaice(ji,jj,jl) .GT. a_i(ji,jj,jl1) - zeps ) THEN 
     866                     IF (zdaice(ji,jj,jl) .LT. a_i(ji,jj,jl1)+zeps) THEN 
     867                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    863868                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    864869                     ELSE 
    865                         zdaice(ji,jj,jl) = 0.0    ! shift no ice 
    866                         zdvice(ji,jj,jl) = 0.0 
     870                        zdaice_greater_aicen = .true. 
    867871                     ENDIF 
    868                   ELSE 
    869                      zdvice_negative = .true. 
    870872                  ENDIF 
    871                ENDIF 
    872  
    873             ! If daice is close to aicen, set daice = aicen. 
    874                IF (zdaice(ji,jj,jl) .GT. a_i(ji,jj,jl1) - zeps ) THEN 
    875                   IF (zdaice(ji,jj,jl) .LT. a_i(ji,jj,jl1)+zeps) THEN 
    876                      zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    877                      zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    878                   ELSE 
    879                      zdaice_greater_aicen = .true. 
     873 
     874                  IF (zdvice(ji,jj,jl) .GT. v_i(ji,jj,jl1)-zeps) THEN 
     875                     IF (zdvice(ji,jj,jl) .LT. v_i(ji,jj,jl1)+zeps) THEN 
     876                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
     877                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
     878                     ELSE 
     879                        zdvice_greater_vicen = .true. 
     880                     ENDIF 
    880881                  ENDIF 
    881                ENDIF 
    882  
    883                IF (zdvice(ji,jj,jl) .GT. v_i(ji,jj,jl1)-zeps) THEN 
    884                   IF (zdvice(ji,jj,jl) .LT. v_i(ji,jj,jl1)+zeps) THEN 
    885                      zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    886                      zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    887                   ELSE 
    888                      zdvice_greater_vicen = .true. 
    889                   ENDIF 
    890                ENDIF 
    891  
    892             ENDIF               ! donor > 0 
    893          END DO                   ! i 
     882 
     883               ENDIF               ! donor > 0 
     884            END DO                   ! i 
    894885         END DO                 ! j 
    895886 
    896887      END DO !jl 
    897888 
    898 !------------------------------------------------------------------------------- 
    899 ! 3) Transfer volume and energy between categories 
    900 !------------------------------------------------------------------------------- 
     889      !------------------------------------------------------------------------------- 
     890      ! 3) Transfer volume and energy between categories 
     891      !------------------------------------------------------------------------------- 
    901892 
    902893      DO jl = klbnd, kubnd - 1 
    … …  
    10121003      DO jl = klbnd, kubnd 
    10131004         DO jj = 1, jpj 
    1014          DO ji = 1, jpi  
    1015             IF ( a_i(ji,jj,jl) .GT. zeps ) THEN  
    1016                ht_i(ji,jj,jl)  =  v_i(ji,jj,jl) / a_i(ji,jj,jl)  
    1017                t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl)  
    1018                zindsn          =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl))) !0 if no ice and 1 if yes 
    1019             ELSE 
    1020                ht_i(ji,jj,jl)  = 0.0 
    1021                t_su(ji,jj,jl)  = rtt 
    1022             ENDIF 
    1023          END DO                 ! ji 
     1005            DO ji = 1, jpi  
     1006               IF ( a_i(ji,jj,jl) .GT. zeps ) THEN  
     1007                  ht_i(ji,jj,jl)  =  v_i(ji,jj,jl) / a_i(ji,jj,jl)  
     1008                  t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl)  
     1009                  zindsn          =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl))) !0 if no ice and 1 if yes 
     1010               ELSE 
     1011                  ht_i(ji,jj,jl)  = 0.0 
     1012                  t_su(ji,jj,jl)  = rtt 
     1013               ENDIF 
     1014            END DO                 ! ji 
    10241015         END DO                 ! jj 
    10251016      END DO                    ! jl 
    10261017 
    1027     END SUBROUTINE lim_itd_shiftice 
    1028  
    1029 !---------------------------------------------------------------------------------------- 
    1030 !---------------------------------------------------------------------------------------- 
    1031  
    1032     SUBROUTINE lim_itd_th_reb(klbnd, kubnd, ntyp) 
    1033         !!------------------------------------------------------------------ 
    1034         !!                ***  ROUTINE lim_itd_th_reb *** 
    1035         !! ** Purpose : rebin - rebins thicknesses into defined categories 
    1036         !! 
    1037         !! ** Method  : 
    1038         !! 
    1039         !! ** Arguments : 
    1040         !! 
    1041         !! ** Inputs / Ouputs : (global commons) 
    1042         !! 
    1043         !! ** External :  
    1044         !! 
    1045         !! ** References : 
    1046         !! 
    1047         !! ** History : (2005) Translation from CICE 
    1048         !!              (2006) Adaptation to include salt, age and types 
    1049         !!              (2007) Mass conservation checked 
    1050         !! 
    1051         !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 
    1052         !!          (01-2006) Martin Vancoppenolle (adaptation) 
    1053         !! 
    1054         !!------------------------------------------------------------------ 
    1055         !! * Arguments 
     1018   END SUBROUTINE lim_itd_shiftice 
     1019   ! 
     1020 
     1021   SUBROUTINE lim_itd_th_reb(klbnd, kubnd, ntyp) 
     1022      !!------------------------------------------------------------------ 
     1023      !!                ***  ROUTINE lim_itd_th_reb *** 
     1024      !! ** Purpose : rebin - rebins thicknesses into defined categories 
     1025      !! 
     1026      !! ** Method  : 
     1027      !! 
     1028      !! ** Arguments : 
     1029      !! 
     1030      !! ** Inputs / Ouputs : (global commons) 
     1031      !! 
     1032      !! ** External :  
     1033      !! 
     1034      !! ** References : 
     1035      !! 
     1036      !! ** History : (2005) Translation from CICE 
     1037      !!              (2006) Adaptation to include salt, age and types 
     1038      !!              (2007) Mass conservation checked 
     1039      !! 
     1040      !! authors: William H. Lipscomb, LANL, Elizabeth C. Hunke, LANL 
     1041      !!          (01-2006) Martin Vancoppenolle (adaptation) 
     1042      !! 
     1043      !!------------------------------------------------------------------ 
     1044      !! * Arguments 
    10561045      INTEGER , INTENT (in) ::  & 
    1057           klbnd ,  &  ! Start thickness category index point 
    1058           kubnd ,  &  ! End point on which the  the computation is applied 
    1059           ntyp        ! number of the ice type involved in the rebinning process 
     1046         klbnd ,  &  ! Start thickness category index point 
     1047         kubnd ,  &  ! End point on which the  the computation is applied 
     1048         ntyp        ! number of the ice type involved in the rebinning process 
    10601049 
    10611050      INTEGER :: & 
    … …  
    10811070         vt_s_init, vt_s_final       !  snow volume summed over categories 
    10821071 
    1083        CHARACTER (len = 15) :: fieldid 
    1084  
    1085 !!-- End of declarations 
    1086 !------------------------------------------------------------------------------ 
    1087  
    1088 !     ! conservation check 
     1072      CHARACTER (len = 15) :: fieldid 
     1073 
     1074      !!-- End of declarations 
     1075      !------------------------------------------------------------------------------ 
     1076 
     1077      !     ! conservation check 
    10891078      IF ( con_i ) THEN 
    10901079         CALL lim_column_sum (jpl,   v_i, vt_i_init) 
    … …  
    10921081      ENDIF 
    10931082 
    1094 ! 
    1095 !------------------------------------------------------------------------------ 
    1096 ! 1) Compute ice thickness. 
    1097 !------------------------------------------------------------------------------ 
     1083      ! 
     1084      !------------------------------------------------------------------------------ 
     1085      ! 1) Compute ice thickness. 
     1086      !------------------------------------------------------------------------------ 
    10981087      DO jl = klbnd, kubnd 
    10991088         DO jj = 1, jpj 
    1100          DO ji = 1, jpi  
    1101             IF (a_i(ji,jj,jl) .GT. zeps) THEN  
    1102                ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    1103             ELSE 
    1104                ht_i(ji,jj,jl) = 0.0 
    1105             ENDIF 
    1106          END DO                 ! i 
     1089            DO ji = 1, jpi  
     1090               IF (a_i(ji,jj,jl) .GT. zeps) THEN  
     1091                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     1092               ELSE 
     1093                  ht_i(ji,jj,jl) = 0.0 
     1094               ENDIF 
     1095            END DO                 ! i 
    11071096         END DO                 ! j 
    11081097      END DO                    ! n 
    11091098 
    1110 !------------------------------------------------------------------------------ 
    1111 ! 2) Make sure thickness of cat klbnd is at least hi_max_typ(klbnd) 
    1112 !------------------------------------------------------------------------------ 
     1099      !------------------------------------------------------------------------------ 
     1100      ! 2) Make sure thickness of cat klbnd is at least hi_max_typ(klbnd) 
     1101      !------------------------------------------------------------------------------ 
    11131102      DO jj = 1, jpj  
    1114       DO ji = 1, jpi  
    1115  
    1116          IF (a_i(ji,jj,klbnd) > zeps) THEN 
    1117             IF (ht_i(ji,jj,klbnd) .LE. hi_max_typ(0,ntyp) .AND. hi_max_typ(0,ntyp) .GT. 0.0 ) THEN 
    1118                a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max_typ(0,ntyp)  
    1119                ht_i(ji,jj,klbnd) = hi_max_typ(0,ntyp) 
     1103         DO ji = 1, jpi  
     1104 
     1105            IF (a_i(ji,jj,klbnd) > zeps) THEN 
     1106               IF (ht_i(ji,jj,klbnd) .LE. hi_max_typ(0,ntyp) .AND. hi_max_typ(0,ntyp) .GT. 0.0 ) THEN 
     1107                  a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max_typ(0,ntyp)  
     1108                  ht_i(ji,jj,klbnd) = hi_max_typ(0,ntyp) 
     1109               ENDIF 
    11201110            ENDIF 
    1121          ENDIF 
    1122       END DO                    ! i 
     1111         END DO                    ! i 
    11231112      END DO                    ! j 
    11241113 
    1125 !------------------------------------------------------------------------------ 
    1126 ! 3) If a category thickness is not in bounds, shift the 
    1127 ! entire area, volume, and energy to the neighboring category 
    1128 !------------------------------------------------------------------------------ 
     1114      !------------------------------------------------------------------------------ 
     1115      ! 3) If a category thickness is not in bounds, shift the 
     1116      ! entire area, volume, and energy to the neighboring category 
     1117      !------------------------------------------------------------------------------ 
    11291118      !------------------------- 
    11301119      ! Initialize shift arrays 
    … …  
    11331122      DO jl = klbnd, kubnd 
    11341123         DO jj = 1, jpj  
    1135          DO ji = 1, jpi 
    1136             zdonor(ji,jj,jl) = 0 
    1137             zdaice(ji,jj,jl) = 0.0 
    1138             zdvice(ji,jj,jl) = 0.0 
    1139          END DO 
     1124            DO ji = 1, jpi 
     1125               zdonor(ji,jj,jl) = 0 
     1126               zdaice(ji,jj,jl) = 0.0 
     1127               zdvice(ji,jj,jl) = 0.0 
     1128            END DO 
    11401129         END DO 
    11411130      END DO 
    … …  
    11471136      DO jl = klbnd, kubnd - 1  ! loop over category boundaries 
    11481137 
    1149       !--------------------------------------- 
    1150       ! identify thicknesses that are too big 
    1151       !--------------------------------------- 
     1138         !--------------------------------------- 
     1139         ! identify thicknesses that are too big 
     1140         !--------------------------------------- 
    11521141         zshiftflag = 0 
    11531142 
    … …  
    11661155         IF ( zshiftflag == 1 ) THEN 
    11671156 
    1168       !------------------------------ 
    1169       ! Shift ice between categories 
    1170       !------------------------------ 
     1157            !------------------------------ 
     1158            ! Shift ice between categories 
     1159            !------------------------------ 
    11711160            CALL lim_itd_shiftice (klbnd, kubnd, zdonor, zdaice, zdvice) 
    1172                   
    1173       !------------------------ 
    1174       ! Reset shift parameters 
    1175       !------------------------ 
     1161 
     1162            !------------------------ 
     1163            ! Reset shift parameters 
     1164            !------------------------ 
    11761165            DO jj = 1, jpj 
    1177             DO ji = 1, jpi 
    1178                zdonor(ji,jj,jl) = 0 
    1179                zdaice(ji,jj,jl) = 0.0 
    1180                zdvice(ji,jj,jl) = 0.0 
    1181             END DO 
     1166               DO ji = 1, jpi 
     1167                  zdonor(ji,jj,jl) = 0 
     1168                  zdaice(ji,jj,jl) = 0.0 
     1169                  zdvice(ji,jj,jl) = 0.0 
     1170               END DO 
    11821171            END DO 
    11831172 
    … …  
    11921181      DO jl = kubnd - 1, 1, -1       ! loop over category boundaries 
    11931182 
    1194       !----------------------------------------- 
    1195       ! Identify thicknesses that are too small 
    1196       !----------------------------------------- 
     1183         !----------------------------------------- 
     1184         ! Identify thicknesses that are too small 
     1185         !----------------------------------------- 
    11971186         zshiftflag = 0 
    11981187 
    … …  
    12131202         IF (zshiftflag==1) THEN 
    12141203 
    1215       !------------------------------ 
    1216       ! Shift ice between categories 
    1217       !------------------------------ 
     1204            !------------------------------ 
     1205            ! Shift ice between categories 
     1206            !------------------------------ 
    12181207            CALL lim_itd_shiftice (klbnd, kubnd, zdonor, zdaice, zdvice) 
    12191208 
    1220       !------------------------ 
    1221       ! Reset shift parameters 
    1222       !------------------------ 
     1209            !------------------------ 
     1210            ! Reset shift parameters 
     1211            !------------------------ 
    12231212            DO jj = 1, jpj  
    1224             DO ji = 1, jpi  
    1225                zdonor(ji,jj,jl)  = 0 
    1226                zdaice(ji,jj,jl)  = 0.0 
    1227                zdvice(ji,jj,jl)  = 0.0 
     1213               DO ji = 1, jpi  
     1214                  zdonor(ji,jj,jl)  = 0 
     1215                  zdaice(ji,jj,jl)  = 0.0 
     1216                  zdvice(ji,jj,jl)  = 0.0 
     1217               END DO 
    12281218            END DO 
    1229             END DO 
    12301219 
    12311220         ENDIF                  ! zshiftflag 
    … …  
    12331222      END DO                    ! jl 
    12341223 
    1235 !------------------------------------------------------------------------------ 
    1236 ! 4) Conservation check 
    1237 !------------------------------------------------------------------------------ 
    1238  
    1239     IF ( con_i ) THEN 
    1240        CALL lim_column_sum (jpl,   v_i, vt_i_final) 
    1241        fieldid = ' v_i : limitd_reb ' 
    1242        CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid)  
    1243  
    1244        CALL lim_column_sum (jpl,   v_s, vt_s_final) 
    1245        fieldid = ' v_s : limitd_reb ' 
    1246        CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)  
    1247     ENDIF 
    1248  
    1249     END SUBROUTINE lim_itd_th_reb 
     1224      !------------------------------------------------------------------------------ 
     1225      ! 4) Conservation check 
     1226      !------------------------------------------------------------------------------ 
     1227 
     1228      IF ( con_i ) THEN 
     1229         CALL lim_column_sum (jpl,   v_i, vt_i_final) 
     1230         fieldid = ' v_i : limitd_reb ' 
     1231         CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid)  
     1232 
     1233         CALL lim_column_sum (jpl,   v_s, vt_s_final) 
     1234         fieldid = ' v_s : limitd_reb ' 
     1235         CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)  
     1236      ENDIF 
     1237 
     1238   END SUBROUTINE lim_itd_th_reb 
    12501239 
    12511240#else 
    … …  
    12681257   END SUBROUTINE lim_itd_th_reb 
    12691258#endif 
    1270  END MODULE limitd_th 
     1259END MODULE limitd_th 

  • trunk/NEMO/LIM_SRC_3/limmsh.F90

    r888 r921  
    5353      REAL(wp), DIMENSION(jpi,jpj) ::  & 
    5454         zd2d1 , zd1d2       ! Derivative of zh2 (resp. zh1) in the x direction 
    55          !                   ! (resp. y direction) (defined at the center) 
     55      !                   ! (resp. y direction) (defined at the center) 
    5656      REAL(wp) ::         & 
    5757         zh1p  , zh2p   , &  ! Idem zh1, zh2 for the bottom left corner of the grid 
    … …  
    6565         WRITE(numout,*) '~~~~~~~' 
    6666      ENDIF 
    67        
     67 
    6868      !----------------------------------------------------------                           
    6969      !    Initialization of local and some global (common) variables  
    7070      !------------------------------------------------------------------  
    71        
     71 
    7272      njeq   = INT( jpj / 2 )   !i bug mpp potentiel 
    7373      njeqm1 = njeq - 1  
    7474 
    7575      fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad )   !  coriolis factor 
    76   
     76 
    7777      IF( fcor(1,1) * fcor(1,nlcj) < 0.e0 ) THEN   ! local domain include both hemisphere 
    7878         l_jeq = .TRUE. 
    … …  
    9797      !   For each grid, definition of geometric tables  
    9898      !------------------------------------------------------------------ 
    99        
     99 
    100100      !------------------- 
    101101      ! Conventions :    ! 
    … …  
    106106      !  3 = corner SW x(i-1/2),y(j-1/2) 
    107107      !------------------- 
    108 !!ibug ??? 
     108      !!ibug ??? 
    109109      akappa(:,:,:,:) = 0.e0 
    110110      wght(:,:,:,:) = 0.e0 
    … …  
    112112      tmu(:,:) = 0.e0 
    113113      tmv(:,:) = 0.0e0 ! CGrid EVP 
    114 !!i 
     114      !!i 
    115115      ! metric coefficients for sea ice dynamic 
    116116      !---------------------------------------- 
    … …  
    130130      akappa(:,:,2,1) = zd2d1(:,:) / ( 4.0 * e1t(:,:) * e2t(:,:) ) 
    131131      akappa(:,:,2,2) =        1.0 / ( 2.0 * e2t(:,:) ) 
    132        
     132 
    133133      !                                                      ! weights (wght) 
    134134      DO jj = 2, jpj 
    … …  
    146146      CALL lbc_lnk( wght(:,:,2,1), 'I', 1. )      ! but it is never used 
    147147      CALL lbc_lnk( wght(:,:,2,2), 'I', 1. ) 
    148      
     148 
    149149      ! Coefficients for divergence of the stress tensor 
    150150      !------------------------------------------------- 
    … …  
    209209      CALL lbc_lnk( alambd(:,:,2,1,1,1), 'I', 1. )      ! 
    210210      CALL lbc_lnk( alambd(:,:,2,1,1,2), 'I', 1. )      ! 
    211              
     211 
    212212 
    213213      ! Initialization of ice masks 
    214214      !---------------------------- 
    215        
     215 
    216216      tms(:,:) = tmask(:,:,1)      ! ice T-point  : use surface tmask 
    217217 
    218 !      tmu(:,1) = 0.e0 
    219 !      tmu(1,:) = 0.e0 
    220 !      tmv(:,1) = 0.e0 
    221 !      tmv(1,:) = 0.e0 
     218      !      tmu(:,1) = 0.e0 
     219      !      tmu(1,:) = 0.e0 
     220      !      tmv(:,1) = 0.e0 
     221      !      tmv(1,:) = 0.e0 
    222222 
    223223      DO jj = 1, jpj - 1 
    … …  
    226226            tmv(ji,jj) =  tms(ji,jj) * tms(ji,jj+1) 
    227227            tmf(ji,jj) =  tms(ji,jj) * tms(ji+1,jj) * tms(ji,jj+1) * & 
    228                           tms(ji+1,jj+1) 
    229          END DO 
    230       END DO 
    231        
     228               tms(ji+1,jj+1) 
     229         END DO 
     230      END DO 
     231 
    232232      !--lateral boundary conditions     
    233233      CALL lbc_lnk( tmu(:,:), 'U', 1. ) 
    234234      CALL lbc_lnk( tmv(:,:), 'V', 1. ) 
    235235      CALL lbc_lnk( tmf(:,:), 'F', 1. ) 
    236        
     236 
    237237      ! unmasked and masked area of T-grid cell 
    238238      area(:,:) = e1t(:,:) * e2t(:,:) 
    239        
     239 
    240240   END SUBROUTINE lim_msh 
    241241 

  • trunk/NEMO/LIM_SRC_3/limrhg.F90

    r888 r921  
    139139         zc1           ,             & !: ice mass 
    140140         zusw          ,             & !: temporary weight for the computation 
    141                                        !: of ice strength 
     141                                !: of ice strength 
    142142         u_oce1, v_oce1,             & !: ocean u/v component on U points                            
    143143         u_oce2, v_oce2,             & !: ocean u/v component on V points 
    … …  
    180180         zresr                         !: Local error on velocity 
    181181 
    182 ! 
    183 !------------------------------------------------------------------------------! 
    184 ! 1) Ice-Snow mass (zc1), ice strength (zpresh)                                ! 
    185 !------------------------------------------------------------------------------! 
    186 ! 
     182      ! 
     183      !------------------------------------------------------------------------------! 
     184      ! 1) Ice-Snow mass (zc1), ice strength (zpresh)                                ! 
     185      !------------------------------------------------------------------------------! 
     186      ! 
    187187      ! Put every vector to 0 
    188188      zpresh(:,:) = 0.0 ; zc1(:,:) = 0.0 
    … …  
    203203            ! tmi = 1 where there is ice or on land 
    204204            tmi(ji,jj)    = 1.0 - ( 1.0 - MAX( 0.0 , SIGN ( 1.0 , vt_i(ji,jj) - & 
    205                                     epsd ) ) ) * tms(ji,jj) 
     205               epsd ) ) ) * tms(ji,jj) 
    206206         END DO 
    207207      END DO 
    … …  
    213213!CDIR NOVERRCHK 
    214214         DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1) 
    215              zstms          =  tms(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 
    216                 &              tms(ji,jj+1)   * wght(ji+1,jj+1,1,2) + & 
    217                 &              tms(ji+1,jj)   * wght(ji+1,jj+1,2,1) + & 
    218                 &              tms(ji,jj)     * wght(ji+1,jj+1,1,1) 
    219              zusw(ji,jj)    = 1.0 / MAX( zstms, epsd ) 
    220              zpreshc(ji,jj) = (  zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 
    221                 &                zpresh(ji,jj+1)   * wght(ji+1,jj+1,1,2) + & 
    222                 &                zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + &  
    223                 &                zpresh(ji,jj)     * wght(ji+1,jj+1,1,1)   & 
    224                 &             ) * zusw(ji,jj) 
     215            zstms          =  tms(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 
     216               &              tms(ji,jj+1)   * wght(ji+1,jj+1,1,2) + & 
     217               &              tms(ji+1,jj)   * wght(ji+1,jj+1,2,1) + & 
     218               &              tms(ji,jj)     * wght(ji+1,jj+1,1,1) 
     219            zusw(ji,jj)    = 1.0 / MAX( zstms, epsd ) 
     220            zpreshc(ji,jj) = (  zpresh(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + & 
     221               &                zpresh(ji,jj+1)   * wght(ji+1,jj+1,1,2) + & 
     222               &                zpresh(ji+1,jj)   * wght(ji+1,jj+1,2,1) + &  
     223               &                zpresh(ji,jj)     * wght(ji+1,jj+1,1,1)   & 
     224               &             ) * zusw(ji,jj) 
    225225         END DO 
    226226      END DO 
    227227 
    228228      CALL lbc_lnk( zpreshc(:,:), 'F', 1. ) 
    229 ! 
    230 !------------------------------------------------------------------------------! 
    231 ! 2) Wind / ocean stress, mass terms, coriolis terms 
    232 !------------------------------------------------------------------------------! 
    233 ! 
     229      ! 
     230      !------------------------------------------------------------------------------! 
     231      ! 2) Wind / ocean stress, mass terms, coriolis terms 
     232      !------------------------------------------------------------------------------! 
     233      ! 
    234234      !  Wind stress, coriolis and mass terms on the sides of the squares         
    235235      !  zfrld1: lead fraction on U-points                                       
    … …  
    244244      !  u_oce2: ocean u component on v points                          
    245245      !  v_oce2: ocean v component on v points                         
    246           
     246 
    247247      DO jj = k_j1+1, k_jpj-1 
    248248         DO ji = fs_2, fs_jpim1 
    … …  
    255255            ! Leads area. 
    256256            zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + & 
    257      &                        zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + epsd ) 
     257               &                        zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + epsd ) 
    258258            zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + & 
    259      &                        zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + epsd ) 
     259               &                        zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + epsd ) 
    260260 
    261261            ! Mass, coriolis coeff. and currents 
    … …  
    263263            zmass2(ji,jj) = ( zt22*zc1(ji,jj) + zt21*zc1(ji,jj+1) ) / (zt21+zt22+epsd) 
    264264            zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj)*fcor(ji,jj) + & 
    265                                               e1t(ji,jj)*fcor(ji+1,jj) ) & 
    266                                            / (e1t(ji,jj) + e1t(ji+1,jj) + epsd ) 
     265               e1t(ji,jj)*fcor(ji+1,jj) ) & 
     266               / (e1t(ji,jj) + e1t(ji+1,jj) + epsd ) 
    267267            zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1)*fcor(ji,jj) + & 
    268                                               e2t(ji,jj)*fcor(ji,jj+1) ) & 
    269                                           / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd ) 
     268               e2t(ji,jj)*fcor(ji,jj+1) ) & 
     269               / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd ) 
    270270            ! 
    271271            u_oce1(ji,jj)  = u_oce(ji,jj) 
    … …  
    274274            ! Ocean has no slip boundary condition 
    275275            v_oce1(ji,jj)  = 0.5*( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj)    & 
    276                 &                 +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) & 
    277                 &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)   
     276               &                 +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) & 
     277               &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)   
    278278 
    279279            u_oce2(ji,jj)  = 0.5*((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj)     & 
    280                 &                 +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) & 
    281                 &                / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
     280               &                 +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) & 
     281               &                / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    282282 
    283283            ! Wind stress. 
    … …  
    302302      END DO 
    303303 
    304 ! 
    305 !------------------------------------------------------------------------------! 
    306 ! 3) Solution of the momentum equation, iterative procedure 
    307 !------------------------------------------------------------------------------! 
    308 ! 
     304      ! 
     305      !------------------------------------------------------------------------------! 
     306      ! 3) Solution of the momentum equation, iterative procedure 
     307      !------------------------------------------------------------------------------! 
     308      ! 
    309309      ! Time step for subcycling 
    310310      dtevp  = rdt_ice / nevp 
    … …  
    319319      zs12(:,:) = stress12_i(:,:) 
    320320 
    321                                                       !----------------------! 
     321      !----------------------! 
    322322      DO jter = 1 , nevp                              !    loop over jter    ! 
    323                                                       !----------------------!         
     323         !----------------------!         
    324324         DO jj = k_j1, k_jpj-1 
    325325            zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 
    326326            zv_ice(:,jj) = v_ice(:,jj) 
    327          END DO       
     327         END DO 
    328328 
    329329         DO jj = k_j1+1, k_jpj-1 
    330330            DO ji = fs_2, fs_jpim1 
    331331 
    332          !   
    333          !- Divergence, tension and shear (Section a. Appendix B of Hunke & Dukowicz, 2002) 
    334          !- zdd(:,:), zdt(:,:): divergence and tension at centre of grid cells 
    335          !- zds(:,:): shear on northeast corner of grid cells 
    336                  ! 
    337                  !- IMPORTANT REMINDER: Dear Gurvan, note that, the way these terms are coded,  
    338                  !                      there are many repeated calculations.  
    339                  !                      Speed could be improved by regrouping terms. For 
    340                  !                      the moment, however, the stress is on clarity of coding to avoid 
    341                  !                      bugs (Martin, for Miguel). 
    342                  ! 
    343                  !- ALSO: arrays zdd, zdt, zds and delta could  
    344                  !  be removed in the future to minimise memory demand. 
    345                  ! 
    346                  !- MORE NOTES: Note that we are calculating deformation rates and stresses on the corners of 
    347                  !              grid cells, exactly as in the B grid case. For simplicity, the indexation on 
    348                  !              the corners is the same as in the B grid. 
    349                  ! 
    350                  ! 
    351                  zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
    352                     &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
    353                     &          +e1v(ji,jj)*v_ice(ji,jj)                      & 
    354                     &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
    355                     &          )                                             & 
    356                     &         / area(ji,jj) 
    357  
    358                  zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    & 
    359                     &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                & 
    360                     &           )*e2t(ji,jj)*e2t(ji,jj)                      & 
    361                     &          -( v_ice(ji,jj)/e1v(ji,jj)                    & 
    362                     &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                & 
    363                     &           )*e1t(ji,jj)*e1t(ji,jj)                      & 
    364                     &         )                                              & 
    365                     &        / area(ji,jj) 
    366  
    367                  ! 
    368                  zds(ji,jj) = ( ( u_ice(ji,jj+1)/e1u(ji,jj+1)                & 
    369                     &            -u_ice(ji,jj)/e1u(ji,jj)                    & 
    370                     &           )*e1f(ji,jj)*e1f(ji,jj)                      & 
    371                     &          +( v_ice(ji+1,jj)/e2v(ji+1,jj)                & 
    372                     &            -v_ice(ji,jj)/e2v(ji,jj)                    & 
    373                     &           )*e2f(ji,jj)*e2f(ji,jj)                      & 
    374                     &         )                                              & 
    375                     &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) & 
    376                     &        * tmi(ji,jj) * tmi(ji,jj+1)                     & 
    377                     &        * tmi(ji+1,jj) * tmi(ji+1,jj+1) 
    378  
    379   
    380                  v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
    381                     &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
    382                     &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)  
    383  
    384                  u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   & 
    385                     &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 
    386                     &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    387  
    388               END DO 
    389            END DO 
    390            CALL lbc_lnk( v_ice1(:,:), 'U', -1. ) 
    391            CALL lbc_lnk( u_ice2(:,:), 'V', -1. ) 
    392  
    393 !CDIR NOVERRCHK 
    394            DO jj = k_j1+1, k_jpj-1 
    395 !CDIR NOVERRCHK 
    396               DO ji = fs_2, fs_jpim1 
    397  
    398                  !- Calculate Delta at centre of grid cells 
    399                  zdst       = (  e2u( ji  , jj   ) * v_ice1(ji,jj)            & 
    400                     &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)          & 
    401                     &          + e1v( ji  , jj   ) * u_ice2(ji,jj)            & 
    402                     &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1)          & 
    403                     &          )                                              & 
    404                     &         / area(ji,jj) 
    405  
    406                  delta = SQRT( zdd(ji,jj)*zdd(ji,jj) +                        &  
    407      &                       ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )   
    408                  deltat(ji,jj) = MAX( SQRT(zdd(ji,jj)**2 +                    & 
    409                                  (zdt(ji,jj)**2 + zdst**2)*usecc2), creepl ) 
    410  
    411                  !-Calculate stress tensor components zs1 and zs2  
    412                  !-at centre of grid cells (see section 3.5 of CICE user's guide). 
    413                  zs1(ji,jj) = ( zs1(ji,jj) & 
    414                     &          - dtotel*( ( 1.0 - alphaevp) * zs1(ji,jj) +    & 
    415                     &            ( delta / deltat(ji,jj) - zdd(ji,jj) / deltat(ji,jj) ) & 
    416                                  * zpresh(ji,jj) ) )                          &        
    417                     &        / ( 1.0 + alphaevp * dtotel ) 
    418  
    419                  zs2(ji,jj) = ( zs2(ji,jj)   & 
    420                     &          - dtotel*((1.0-alphaevp)*ecc2*zs2(ji,jj) -  & 
    421                                  zdt(ji,jj)/deltat(ji,jj)*zpresh(ji,jj)) ) & 
    422                     &        / ( 1.0 + alphaevp*ecc2*dtotel ) 
    423  
    424               END DO 
    425            END DO 
    426  
    427            CALL lbc_lnk( zs1(:,:), 'T', 1. ) 
    428            CALL lbc_lnk( zs2(:,:), 'T', 1. ) 
    429  
    430 !CDIR NOVERRCHK 
    431            DO jj = k_j1+1, k_jpj-1 
    432 !CDIR NOVERRCHK 
    433               DO ji = fs_2, fs_jpim1 
    434                  !- Calculate Delta on corners 
    435                  zddc  =      ( ( v_ice1(ji,jj+1)/e1u(ji,jj+1)                & 
    436                     &            -v_ice1(ji,jj)/e1u(ji,jj)                    & 
    437                     &           )*e1f(ji,jj)*e1f(ji,jj)                       & 
    438                     &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                & 
    439                     &            -u_ice2(ji,jj)/e2v(ji,jj)                    & 
    440                     &           )*e2f(ji,jj)*e2f(ji,jj)                       & 
    441                     &         )                                               & 
    442                     &        / ( e1f(ji,jj) * e2f(ji,jj) ) 
    443  
    444                  zdtc  =      (-( v_ice1(ji,jj+1)/e1u(ji,jj+1)                & 
    445                     &            -v_ice1(ji,jj)/e1u(ji,jj)                    & 
    446                     &           )*e1f(ji,jj)*e1f(ji,jj)                       & 
    447                     &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                & 
    448                     &            -u_ice2(ji,jj)/e2v(ji,jj)                    & 
    449                     &           )*e2f(ji,jj)*e2f(ji,jj)                       & 
    450                     &         )                                               & 
    451                     &        / ( e1f(ji,jj) * e2f(ji,jj) ) 
    452  
    453                  deltac(ji,jj) = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl 
    454  
    455                  !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide). 
    456                  zs12(ji,jj) = ( zs12(ji,jj)      & 
    457                     &        - dtotel*( (1.0-alphaevp)*ecc2*zs12(ji,jj) - zds(ji,jj) / & 
    458                     &          ( 2.0*deltac(ji,jj) ) * zpreshc(ji,jj))) & 
    459                     &         / ( 1.0 + alphaevp*ecc2*dtotel )  
    460  
    461               END DO ! ji 
    462            END DO ! jj 
    463  
    464            CALL lbc_lnk( zs12(:,:), 'F', 1. ) 
    465  
    466            ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) 
    467            DO jj = k_j1+1, k_jpj-1 
    468               DO ji = fs_2, fs_jpim1 
    469                 !- contribution of zs1, zs2 and zs12 to zf1 
    470                 zf1(ji,jj) = 0.5*( (zs1(ji+1,jj)-zs1(ji,jj))*e2u(ji,jj) & 
    471                    &              +(zs2(ji+1,jj)*e2t(ji+1,jj)**2-zs2(ji,jj)*e2t(ji,jj)**2)/e2u(ji,jj) & 
    472                    &              +2.0*(zs12(ji,jj)*e1f(ji,jj)**2-zs12(ji,jj-1)*e1f(ji,jj-1)**2)/e1u(ji,jj) & 
    473                    &             ) / ( e1u(ji,jj)*e2u(ji,jj) ) 
    474                 ! contribution of zs1, zs2 and zs12 to zf2 
    475                 zf2(ji,jj) = 0.5*( (zs1(ji,jj+1)-zs1(ji,jj))*e1v(ji,jj) & 
    476                    &              -(zs2(ji,jj+1)*e1t(ji,jj+1)**2 - zs2(ji,jj)*e1t(ji,jj)**2)/e1v(ji,jj) & 
    477                    &              + 2.0*(zs12(ji,jj)*e2f(ji,jj)**2 -    & 
    478                                     zs12(ji-1,jj)*e2f(ji-1,jj)**2)/e2v(ji,jj) & 
    479                    &             ) / ( e1v(ji,jj)*e2v(ji,jj) ) 
    480               END DO 
    481            END DO 
     332               !   
     333               !- Divergence, tension and shear (Section a. Appendix B of Hunke & Dukowicz, 2002) 
     334               !- zdd(:,:), zdt(:,:): divergence and tension at centre of grid cells 
     335               !- zds(:,:): shear on northeast corner of grid cells 
     336               ! 
     337               !- IMPORTANT REMINDER: Dear Gurvan, note that, the way these terms are coded,  
     338               !                      there are many repeated calculations.  
     339               !                      Speed could be improved by regrouping terms. For 
     340               !                      the moment, however, the stress is on clarity of coding to avoid 
     341               !                      bugs (Martin, for Miguel). 
     342               ! 
     343               !- ALSO: arrays zdd, zdt, zds and delta could  
     344               !  be removed in the future to minimise memory demand. 
     345               ! 
     346               !- MORE NOTES: Note that we are calculating deformation rates and stresses on the corners of 
     347               !              grid cells, exactly as in the B grid case. For simplicity, the indexation on 
     348               !              the corners is the same as in the B grid. 
     349               ! 
     350               ! 
     351               zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
     352                  &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
     353                  &          +e1v(ji,jj)*v_ice(ji,jj)                      & 
     354                  &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
     355                  &          )                                             & 
     356                  &         / area(ji,jj) 
     357 
     358               zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    & 
     359                  &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                & 
     360                  &           )*e2t(ji,jj)*e2t(ji,jj)                      & 
     361                  &          -( v_ice(ji,jj)/e1v(ji,jj)                    & 
     362                  &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                & 
     363                  &           )*e1t(ji,jj)*e1t(ji,jj)                      & 
     364                  &         )                                              & 
     365                  &        / area(ji,jj) 
     366 
     367               ! 
     368               zds(ji,jj) = ( ( u_ice(ji,jj+1)/e1u(ji,jj+1)                & 
     369                  &            -u_ice(ji,jj)/e1u(ji,jj)                    & 
     370                  &           )*e1f(ji,jj)*e1f(ji,jj)                      & 
     371                  &          +( v_ice(ji+1,jj)/e2v(ji+1,jj)                & 
     372                  &            -v_ice(ji,jj)/e2v(ji,jj)                    & 
     373                  &           )*e2f(ji,jj)*e2f(ji,jj)                      & 
     374                  &         )                                              & 
     375                  &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) & 
     376                  &        * tmi(ji,jj) * tmi(ji,jj+1)                     & 
     377                  &        * tmi(ji+1,jj) * tmi(ji+1,jj+1) 
     378 
     379 
     380               v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
     381                  &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
     382                  &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)  
     383 
     384               u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   & 
     385                  &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 
     386                  &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
     387 
     388            END DO 
     389         END DO 
     390         CALL lbc_lnk( v_ice1(:,:), 'U', -1. ) 
     391         CALL lbc_lnk( u_ice2(:,:), 'V', -1. ) 
     392 
     393!CDIR NOVERRCHK 
     394         DO jj = k_j1+1, k_jpj-1 
     395!CDIR NOVERRCHK 
     396            DO ji = fs_2, fs_jpim1 
     397 
     398               !- Calculate Delta at centre of grid cells 
     399               zdst       = (  e2u( ji  , jj   ) * v_ice1(ji,jj)            & 
     400                  &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)          & 
     401                  &          + e1v( ji  , jj   ) * u_ice2(ji,jj)            & 
     402                  &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1)          & 
     403                  &          )                                              & 
     404                  &         / area(ji,jj) 
     405 
     406               delta = SQRT( zdd(ji,jj)*zdd(ji,jj) +                        &  
     407                  &                       ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )   
     408               deltat(ji,jj) = MAX( SQRT(zdd(ji,jj)**2 +                    & 
     409                  (zdt(ji,jj)**2 + zdst**2)*usecc2), creepl ) 
     410 
     411               !-Calculate stress tensor components zs1 and zs2  
     412               !-at centre of grid cells (see section 3.5 of CICE user's guide). 
     413               zs1(ji,jj) = ( zs1(ji,jj) & 
     414                  &          - dtotel*( ( 1.0 - alphaevp) * zs1(ji,jj) +    & 
     415                  &            ( delta / deltat(ji,jj) - zdd(ji,jj) / deltat(ji,jj) ) & 
     416                  * zpresh(ji,jj) ) )                          &        
     417                  &        / ( 1.0 + alphaevp * dtotel ) 
     418 
     419               zs2(ji,jj) = ( zs2(ji,jj)   & 
     420                  &          - dtotel*((1.0-alphaevp)*ecc2*zs2(ji,jj) -  & 
     421                  zdt(ji,jj)/deltat(ji,jj)*zpresh(ji,jj)) ) & 
     422                  &        / ( 1.0 + alphaevp*ecc2*dtotel ) 
     423 
     424            END DO 
     425         END DO 
     426 
     427         CALL lbc_lnk( zs1(:,:), 'T', 1. ) 
     428         CALL lbc_lnk( zs2(:,:), 'T', 1. ) 
     429 
     430!CDIR NOVERRCHK 
     431         DO jj = k_j1+1, k_jpj-1 
     432!CDIR NOVERRCHK 
     433            DO ji = fs_2, fs_jpim1 
     434               !- Calculate Delta on corners 
     435               zddc  =      ( ( v_ice1(ji,jj+1)/e1u(ji,jj+1)                & 
     436                  &            -v_ice1(ji,jj)/e1u(ji,jj)                    & 
     437                  &           )*e1f(ji,jj)*e1f(ji,jj)                       & 
     438                  &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                & 
     439                  &            -u_ice2(ji,jj)/e2v(ji,jj)                    & 
     440                  &           )*e2f(ji,jj)*e2f(ji,jj)                       & 
     441                  &         )                                               & 
     442                  &        / ( e1f(ji,jj) * e2f(ji,jj) ) 
     443 
     444               zdtc  =      (-( v_ice1(ji,jj+1)/e1u(ji,jj+1)                & 
     445                  &            -v_ice1(ji,jj)/e1u(ji,jj)                    & 
     446                  &           )*e1f(ji,jj)*e1f(ji,jj)                       & 
     447                  &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                & 
     448                  &            -u_ice2(ji,jj)/e2v(ji,jj)                    & 
     449                  &           )*e2f(ji,jj)*e2f(ji,jj)                       & 
     450                  &         )                                               & 
     451                  &        / ( e1f(ji,jj) * e2f(ji,jj) ) 
     452 
     453               deltac(ji,jj) = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl 
     454 
     455               !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide). 
     456               zs12(ji,jj) = ( zs12(ji,jj)      & 
     457                  &        - dtotel*( (1.0-alphaevp)*ecc2*zs12(ji,jj) - zds(ji,jj) / & 
     458                  &          ( 2.0*deltac(ji,jj) ) * zpreshc(ji,jj))) & 
     459                  &         / ( 1.0 + alphaevp*ecc2*dtotel )  
     460 
     461            END DO ! ji 
     462         END DO ! jj 
     463 
     464         CALL lbc_lnk( zs12(:,:), 'F', 1. ) 
     465 
     466         ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) 
     467         DO jj = k_j1+1, k_jpj-1 
     468            DO ji = fs_2, fs_jpim1 
     469               !- contribution of zs1, zs2 and zs12 to zf1 
     470               zf1(ji,jj) = 0.5*( (zs1(ji+1,jj)-zs1(ji,jj))*e2u(ji,jj) & 
     471                  &              +(zs2(ji+1,jj)*e2t(ji+1,jj)**2-zs2(ji,jj)*e2t(ji,jj)**2)/e2u(ji,jj) & 
     472                  &              +2.0*(zs12(ji,jj)*e1f(ji,jj)**2-zs12(ji,jj-1)*e1f(ji,jj-1)**2)/e1u(ji,jj) & 
     473                  &             ) / ( e1u(ji,jj)*e2u(ji,jj) ) 
     474               ! contribution of zs1, zs2 and zs12 to zf2 
     475               zf2(ji,jj) = 0.5*( (zs1(ji,jj+1)-zs1(ji,jj))*e1v(ji,jj) & 
     476                  &              -(zs2(ji,jj+1)*e1t(ji,jj+1)**2 - zs2(ji,jj)*e1t(ji,jj)**2)/e1v(ji,jj) & 
     477                  &              + 2.0*(zs12(ji,jj)*e2f(ji,jj)**2 -    & 
     478                  zs12(ji-1,jj)*e2f(ji-1,jj)**2)/e2v(ji,jj) & 
     479                  &             ) / ( e1v(ji,jj)*e2v(ji,jj) ) 
     480            END DO 
     481         END DO 
    482482         ! 
    483483         ! Computation of ice velocity 
    … …  
    485485         ! Both the Coriolis term and the ice-ocean drag are solved semi-implicitly. 
    486486         ! 
    487            IF (MOD(jter,2).eq.0) THEN  
    488  
    489 !CDIR NOVERRCHK 
    490               DO jj = k_j1+1, k_jpj-1 
    491 !CDIR NOVERRCHK 
    492                  DO ji = fs_2, fs_jpim1 
    493                     zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
    494                     zsang        = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg 
    495                     z0           = zmass1(ji,jj)/dtevp 
    496  
    497                     ! SB modif because ocean has no slip boundary condition 
    498                     zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)         & 
    499                       &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   & 
    500                       &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    501                     za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 
    502                                               (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj)) 
    503                     zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
    504                                    za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj)) 
    505                     zcca         = z0+za*cangvg 
    506                     zccb         = zcorl1(ji,jj)+za*zsang 
    507                     u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    508  
    509                  END DO 
    510               END DO 
    511  
    512               CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    513  
    514 !CDIR NOVERRCHK 
    515               DO jj = k_j1+1, k_jpj-1 
    516 !CDIR NOVERRCHK 
    517                  DO ji = fs_2, fs_jpim1 
    518  
    519                     zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
    520                     zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    521                     z0           = zmass2(ji,jj)/dtevp 
    522                     ! SB modif because ocean has no slip boundary condition 
    523                     zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)     & 
    524                 &                 + (u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   & 
    525                 &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    526                     za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + &  
    527                                    (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
    528                     zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
    529                                    za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj)) 
    530                     zcca         = z0+za*cangvg 
    531                     zccb         = zcorl2(ji,jj)+za*zsang 
    532                     v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    533  
    534                  END DO 
    535               END DO 
    536  
    537               CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
     487         IF (MOD(jter,2).eq.0) THEN  
     488 
     489!CDIR NOVERRCHK 
     490            DO jj = k_j1+1, k_jpj-1 
     491!CDIR NOVERRCHK 
     492               DO ji = fs_2, fs_jpim1 
     493                  zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
     494                  zsang        = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg 
     495                  z0           = zmass1(ji,jj)/dtevp 
     496 
     497                  ! SB modif because ocean has no slip boundary condition 
     498                  zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)         & 
     499                     &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   & 
     500                     &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
     501                  za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 
     502                     (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj)) 
     503                  zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
     504                     za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj)) 
     505                  zcca         = z0+za*cangvg 
     506                  zccb         = zcorl1(ji,jj)+za*zsang 
     507                  u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
     508 
     509               END DO 
     510            END DO 
     511 
     512            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
     513 
     514!CDIR NOVERRCHK 
     515            DO jj = k_j1+1, k_jpj-1 
     516!CDIR NOVERRCHK 
     517               DO ji = fs_2, fs_jpim1 
     518 
     519                  zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
     520                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
     521                  z0           = zmass2(ji,jj)/dtevp 
     522                  ! SB modif because ocean has no slip boundary condition 
     523                  zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)     & 
     524                     &                 + (u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   & 
     525                     &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
     526                  za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + &  
     527                     (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
     528                  zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
     529                     za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj)) 
     530                  zcca         = z0+za*cangvg 
     531                  zccb         = zcorl2(ji,jj)+za*zsang 
     532                  v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
     533 
     534               END DO 
     535            END DO 
     536 
     537            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    538538 
    539539         ELSE  
    540540!CDIR NOVERRCHK 
    541               DO jj = k_j1+1, k_jpj-1 
    542 !CDIR NOVERRCHK 
    543                  DO ji = fs_2, fs_jpim1 
    544                     zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
    545                     zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    546                     z0           = zmass2(ji,jj)/dtevp 
    547                     ! SB modif because ocean has no slip boundary condition 
    548                     zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)      & 
    549                        &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   & 
    550                        &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)    
    551  
    552                     za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + & 
    553                                    (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
    554                     zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
    555                                    za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj)) 
    556                     zcca         = z0+za*cangvg 
    557                     zccb         = zcorl2(ji,jj)+za*zsang 
    558                     v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
    559  
    560                  END DO 
    561               END DO 
    562  
    563               CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    564  
    565 !CDIR NOVERRCHK 
    566               DO jj = k_j1+1, k_jpj-1 
    567 !CDIR NOVERRCHK 
    568                  DO ji = fs_2, fs_jpim1 
    569                     zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
    570                     zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    571                     z0           = zmass1(ji,jj)/dtevp 
    572                     ! SB modif because ocean has no slip boundary condition 
    573 ! GG Bug 
    574 !                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)      & 
    575 !                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj))   & 
    576 !                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    577                     zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)      & 
    578                        &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   & 
    579                        &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    580      
    581                     za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 
    582                                    (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj)) 
    583                     zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
    584                                    za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj)) 
    585                     zcca         = z0+za*cangvg 
    586                     zccb         = zcorl1(ji,jj)+za*zsang 
    587                     u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
    588                  END DO ! ji 
    589               END DO ! jj 
    590  
    591               CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
    592  
    593       ENDIF  
    594  
    595       IF(ln_ctl) THEN 
    596          !---  Convergence test. 
    597          DO jj = k_j1+1 , k_jpj-1 
    598             zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ) ,           & 
    599                           ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
    600          END DO 
    601          zresm = MAXVAL( zresr( 1:jpi , k_j1+1:k_jpj-1 ) ) 
    602          IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain 
    603       ENDIF 
    604  
    605       !                                                   ! ==================== ! 
     541            DO jj = k_j1+1, k_jpj-1 
     542!CDIR NOVERRCHK 
     543               DO ji = fs_2, fs_jpim1 
     544                  zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
     545                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
     546                  z0           = zmass2(ji,jj)/dtevp 
     547                  ! SB modif because ocean has no slip boundary condition 
     548                  zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)      & 
     549                     &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   & 
     550                     &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)    
     551 
     552                  za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + & 
     553                     (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj)) 
     554                  zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + & 
     555                     za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj)) 
     556                  zcca         = z0+za*cangvg 
     557                  zccb         = zcorl2(ji,jj)+za*zsang 
     558                  v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask 
     559 
     560               END DO 
     561            END DO 
     562 
     563            CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
     564 
     565!CDIR NOVERRCHK 
     566            DO jj = k_j1+1, k_jpj-1 
     567!CDIR NOVERRCHK 
     568               DO ji = fs_2, fs_jpim1 
     569                  zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
     570                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
     571                  z0           = zmass1(ji,jj)/dtevp 
     572                  ! SB modif because ocean has no slip boundary condition 
     573                  ! GG Bug 
     574                  !                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)      & 
     575                  !                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj))   & 
     576                  !                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
     577                  zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)      & 
     578                     &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   & 
     579                     &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
     580 
     581                  za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + & 
     582                     (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj)) 
     583                  zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + & 
     584                     za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj)) 
     585                  zcca         = z0+za*cangvg 
     586                  zccb         = zcorl1(ji,jj)+za*zsang 
     587                  u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask  
     588               END DO ! ji 
     589            END DO ! jj 
     590 
     591            CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
     592 
     593         ENDIF 
     594 
     595         IF(ln_ctl) THEN 
     596            !---  Convergence test. 
     597            DO jj = k_j1+1 , k_jpj-1 
     598               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ) ,           & 
     599                  ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
     600            END DO 
     601            zresm = MAXVAL( zresr( 1:jpi , k_j1+1:k_jpj-1 ) ) 
     602            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain 
     603         ENDIF 
     604 
     605         !                                                   ! ==================== ! 
    606606      END DO                                              !  end loop over jter  ! 
    607607      !                                                   ! ==================== ! 
    608608 
    609 ! 
    610 !------------------------------------------------------------------------------! 
    611 ! 4) Prevent ice velocities when the ice is thin 
    612 !------------------------------------------------------------------------------! 
    613 ! 
     609      ! 
     610      !------------------------------------------------------------------------------! 
     611      ! 4) Prevent ice velocities when the ice is thin 
     612      !------------------------------------------------------------------------------! 
     613      ! 
    614614      ! If the ice thickness is below 1cm then ice velocity should equal the 
    615615      ! ocean velocity,  
    … …  
    636636            zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    637637            IF ( zdummy .LE. 5.0e-2 ) THEN 
    638                 v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
    639                    &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
    640                    &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
    641  
    642                 u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   & 
    643                    &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 
    644                    &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    645              ENDIF ! zdummy 
     638               v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
     639                  &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
     640                  &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
     641 
     642               u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   & 
     643                  &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) & 
     644                  &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
     645            ENDIF ! zdummy 
    646646         END DO 
    647647      END DO 
    … …  
    662662            IF ( zdummy .LE. 5.0e-2 ) THEN 
    663663 
    664             zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
    665                &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
    666                &          +e1v(ji,jj)*v_ice(ji,jj)                      & 
    667                &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
    668                &         )                                              & 
    669                &         / area(ji,jj) 
    670  
    671             zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    & 
    672                &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                & 
    673                &           )*e2t(ji,jj)*e2t(ji,jj)                      & 
    674                &          -( v_ice(ji,jj)/e1v(ji,jj)                    & 
    675                &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                & 
    676                &           )*e1t(ji,jj)*e1t(ji,jj)                      & 
    677                &         )                                              & 
    678                &        / area(ji,jj) 
    679             ! 
    680             ! SB modif because ocean has no slip boundary condition  
    681             zds(ji,jj) = ( ( u_ice(ji,jj+1) / e1u(ji,jj+1)              & 
    682                &           - u_ice(ji,jj)   / e1u(ji,jj) )              & 
    683                &           * e1f(ji,jj) * e1f(ji,jj)                    & 
    684                &          + ( v_ice(ji+1,jj) / e2v(ji+1,jj)             & 
    685                &            - v_ice(ji,jj)  / e2v(ji,jj) )              & 
    686                &           * e2f(ji,jj) * e2f(ji,jj) )                  & 
    687                &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) & 
    688                &        * tmi(ji,jj) * tmi(ji,jj+1)                     & 
    689                &        * tmi(ji+1,jj) * tmi(ji+1,jj+1) 
    690  
    691              zdst       = (  e2u( ji  , jj   ) * v_ice1(ji,jj)          & 
    692                &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)         & 
    693                &          + e1v( ji  , jj   ) * u_ice2(ji,jj)           & 
    694                &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1)         &  
    695                &          )                                             & 
    696                &         / area(ji,jj) 
    697  
    698              deltat(ji,jj) = SQRT( zdd(ji,jj)*zdd(ji,jj) + &  
    699      &                          ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 &  
    700      &                          ) + creepl 
    701  
    702              ENDIF ! zdummy 
     664               zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
     665                  &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  & 
     666                  &          +e1v(ji,jj)*v_ice(ji,jj)                      & 
     667                  &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  & 
     668                  &         )                                              & 
     669                  &         / area(ji,jj) 
     670 
     671               zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    & 
     672                  &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                & 
     673                  &           )*e2t(ji,jj)*e2t(ji,jj)                      & 
     674                  &          -( v_ice(ji,jj)/e1v(ji,jj)                    & 
     675                  &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                & 
     676                  &           )*e1t(ji,jj)*e1t(ji,jj)                      & 
     677                  &         )                                              & 
     678                  &        / area(ji,jj) 
     679               ! 
     680               ! SB modif because ocean has no slip boundary condition  
     681               zds(ji,jj) = ( ( u_ice(ji,jj+1) / e1u(ji,jj+1)              & 
     682                  &           - u_ice(ji,jj)   / e1u(ji,jj) )              & 
     683                  &           * e1f(ji,jj) * e1f(ji,jj)                    & 
     684                  &          + ( v_ice(ji+1,jj) / e2v(ji+1,jj)             & 
     685                  &            - v_ice(ji,jj)  / e2v(ji,jj) )              & 
     686                  &           * e2f(ji,jj) * e2f(ji,jj) )                  & 
     687                  &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) & 
     688                  &        * tmi(ji,jj) * tmi(ji,jj+1)                     & 
     689                  &        * tmi(ji+1,jj) * tmi(ji+1,jj+1) 
     690 
     691               zdst       = (  e2u( ji  , jj   ) * v_ice1(ji,jj)          & 
     692                  &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)         & 
     693                  &          + e1v( ji  , jj   ) * u_ice2(ji,jj)           & 
     694                  &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1)         &  
     695                  &          )                                             & 
     696                  &         / area(ji,jj) 
     697 
     698               deltat(ji,jj) = SQRT( zdd(ji,jj)*zdd(ji,jj) + &  
     699                  &                          ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 &  
     700                  &                          ) + creepl 
     701 
     702            ENDIF ! zdummy 
    703703 
    704704         END DO !jj 
    705705      END DO !ji 
    706 ! 
    707 !------------------------------------------------------------------------------! 
    708 ! 5) Store stress tensor and its invariants 
    709 !------------------------------------------------------------------------------! 
    710 ! 
     706      ! 
     707      !------------------------------------------------------------------------------! 
     708      ! 5) Store stress tensor and its invariants 
     709      !------------------------------------------------------------------------------! 
     710      ! 
    711711      ! * Invariants of the stress tensor are required for limitd_me 
    712712      ! accelerates convergence and improves stability 
    … …  
    729729      stress12_i(:,:) = zs12(:,:) 
    730730 
    731 ! 
    732 !------------------------------------------------------------------------------! 
    733 ! 6) Control prints of residual and charge ellipse 
    734 !------------------------------------------------------------------------------! 
    735 ! 
     731      ! 
     732      !------------------------------------------------------------------------------! 
     733      ! 6) Control prints of residual and charge ellipse 
     734      !------------------------------------------------------------------------------! 
     735      ! 
    736736      ! print the residual for convergence 
    737737      IF(ln_ctl) THEN 

  • trunk/NEMO/LIM_SRC_3/limrst.F90

    r919 r921  
    2222   USE daymod 
    2323   USE iom 
    24     
     24 
    2525   IMPLICIT NONE 
    2626   PRIVATE 
    27     
     27 
    2828   !! * Accessibility 
    2929   PUBLIC lim_rst_opn    ! routine called by icestep.F90 
    … …  
    5555      ! 
    5656      IF( kt == nit000 )   lrst_ice = .FALSE.   ! default definition 
    57        
     57 
    5858      ! to get better performances with NetCDF format: 
    5959      ! we open and define the ice restart file one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1) 
    … …  
    101101      CHARACTER(len=1)  :: zchar, zchar1 
    102102      !!---------------------------------------------------------------------- 
    103     
     103 
    104104      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1 
    105105 
    … …  
    294294      ENDIF 
    295295      ! 
    296     
    297    !+++++++++++ CHECK EVERYTHING ++++++++++ 
    298                WRITE(numout,*) 
    299                WRITE(numout,*) ' lim_rst_write : CHUKCHI SEA POINT ' 
    300                WRITE(numout,*) ' ~~~~~~~~~~' 
    301                WRITE(numout,*) ' ~~~ Arctic' 
    302     
    303                ji = jiindx 
    304                jj = jjindx 
    305     
    306                WRITE(numout,*) ' ji, jj ', ji, jj 
    307                WRITE(numout,*) ' ICE VARIABLES ' 
    308                WRITE(numout,*) ' open water ', ato_i(ji,jj) 
    309                DO jl = 1, jpl 
    310                   WRITE(numout,*) ' *** CATEGORY NUMBER *** ', jl 
    311                   WRITE(numout,*) ' ' 
    312                   WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)      
    313                   WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)  
    314                   WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)     
    315                   WRITE(numout,*) ' e_s        : ', e_s(ji,jj,1,jl)/1.0e9 
    316                   WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9       
    317                   WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9       
    318                   WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)   
    319                   WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl) 
    320                   WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl) 
    321                END DO 
    322     
    323                WRITE(numout,*) ' MOMENTS OF ADVECTION ' 
    324     
    325                WRITE(numout,*) ' open water ' 
    326                WRITE(numout,*) ' sxopw  ', sxopw(ji,jj) 
    327                WRITE(numout,*) ' syopw  ', syopw(ji,jj) 
    328                WRITE(numout,*) ' sxxopw ', sxxopw(ji,jj) 
    329                WRITE(numout,*) ' syyopw ', syyopw(ji,jj) 
    330                WRITE(numout,*) ' sxyopw ', sxyopw(ji,jj) 
    331                DO jl = 1, jpl 
    332                   WRITE(numout,*) ' jl, ice volume content ', jl 
    333                   WRITE(numout,*) ' sxice  ', sxice(ji,jj,jl) 
    334                   WRITE(numout,*) ' syice  ', syice(ji,jj,jl) 
    335                   WRITE(numout,*) ' sxxice ', sxxice(ji,jj,jl) 
    336                   WRITE(numout,*) ' syyice ', syyice(ji,jj,jl) 
    337                   WRITE(numout,*) ' sxyice ', sxyice(ji,jj,jl) 
    338                   WRITE(numout,*) ' jl, snow volume content ', jl 
    339                   WRITE(numout,*) ' sxsn   ', sxsn(ji,jj,jl) 
    340                   WRITE(numout,*) ' sysn   ', sysn(ji,jj,jl) 
    341                   WRITE(numout,*) ' sxxsn  ', sxxsn(ji,jj,jl) 
    342                   WRITE(numout,*) ' syysn  ', syysn(ji,jj,jl) 
    343                   WRITE(numout,*) ' sxysn  ', sxysn(ji,jj,jl) 
    344                   WRITE(numout,*) ' jl, ice area in category ', jl 
    345                   WRITE(numout,*) ' sxa    ', sxa (ji,jj,jl) 
    346                   WRITE(numout,*) ' sya    ', sya (ji,jj,jl) 
    347                   WRITE(numout,*) ' sxxa   ', sxxa (ji,jj,jl) 
    348                   WRITE(numout,*) ' syya   ', syya (ji,jj,jl) 
    349                   WRITE(numout,*) ' sxya   ', sxya (ji,jj,jl) 
    350                   WRITE(numout,*) ' jl, snow temp ', jl 
    351                   WRITE(numout,*) ' sxc0   ', sxc0(ji,jj,jl) 
    352                   WRITE(numout,*) ' syc0   ', syc0(ji,jj,jl) 
    353                   WRITE(numout,*) ' sxxc0  ', sxxc0(ji,jj,jl) 
    354                   WRITE(numout,*) ' syyc0  ', syyc0(ji,jj,jl) 
    355                   WRITE(numout,*) ' sxyc0  ', sxyc0(ji,jj,jl) 
    356                   WRITE(numout,*) ' jl, ice salinity ', jl 
    357                   WRITE(numout,*) ' sxsal  ', sxsal(ji,jj,jl) 
    358                   WRITE(numout,*) ' sysal  ', sysal(ji,jj,jl) 
    359                   WRITE(numout,*) ' sxxsal ', sxxsal(ji,jj,jl) 
    360                   WRITE(numout,*) ' syysal ', syysal(ji,jj,jl) 
    361                   WRITE(numout,*) ' sxysal ', sxysal(ji,jj,jl) 
    362                   WRITE(numout,*) ' jl, ice age      ', jl 
    363                   WRITE(numout,*) ' sxage  ', sxage(ji,jj,jl) 
    364                   WRITE(numout,*) ' syage  ', syage(ji,jj,jl) 
    365                   WRITE(numout,*) ' sxxage ', sxxage(ji,jj,jl) 
    366                   WRITE(numout,*) ' syyage ', syyage(ji,jj,jl) 
    367                   WRITE(numout,*) ' sxyage ', sxyage(ji,jj,jl) 
    368                END DO 
    369                DO jl = 1, jpl 
    370                   DO jk = 1, nlay_i 
    371                      WRITE(numout,*) ' jk, jl, ice heat content', jk, jl 
    372                      WRITE(numout,*) ' sxe    ', sxe(ji,jj,jk,jl) 
    373                      WRITE(numout,*) ' sye    ', sye(ji,jj,jk,jl) 
    374                      WRITE(numout,*) ' sxxe   ', sxxe(ji,jj,jk,jl) 
    375                      WRITE(numout,*) ' syye   ', syye(ji,jj,jk,jl) 
    376                      WRITE(numout,*) ' sxye   ', sxye(ji,jj,jk,jl) 
    377                   END DO 
    378                END DO 
    379     
    380    !+++++++++++ END CHECK +++++++++++++++++ 
    381     
    382       END SUBROUTINE lim_rst_write 
    383     
     296 
     297      IF( ln_nicep) THEN 
     298         WRITE(numout,*) 
     299         WRITE(numout,*) ' lim_rst_write : CHUKCHI SEA POINT ' 
     300         WRITE(numout,*) ' ~~~~~~~~~~' 
     301         WRITE(numout,*) ' ~~~ Arctic' 
     302 
     303         ji = jiindx 
     304         jj = jjindx 
     305 
     306         WRITE(numout,*) ' ji, jj ', ji, jj 
     307         WRITE(numout,*) ' ICE VARIABLES ' 
     308         WRITE(numout,*) ' open water ', ato_i(ji,jj) 
     309         DO jl = 1, jpl 
     310            WRITE(numout,*) ' *** CATEGORY NUMBER *** ', jl 
     311            WRITE(numout,*) ' ' 
     312            WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)      
     313            WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)  
     314            WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)     
     315            WRITE(numout,*) ' e_s        : ', e_s(ji,jj,1,jl)/1.0e9 
     316            WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9       
     317            WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9       
     318            WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)   
     319            WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl) 
     320            WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl) 
     321         END DO 
     322 
     323         WRITE(numout,*) ' MOMENTS OF ADVECTION ' 
     324 
     325         WRITE(numout,*) ' open water ' 
     326         WRITE(numout,*) ' sxopw  ', sxopw(ji,jj) 
     327         WRITE(numout,*) ' syopw  ', syopw(ji,jj) 
     328         WRITE(numout,*) ' sxxopw ', sxxopw(ji,jj) 
     329         WRITE(numout,*) ' syyopw ', syyopw(ji,jj) 
     330         WRITE(numout,*) ' sxyopw ', sxyopw(ji,jj) 
     331         DO jl = 1, jpl 
     332            WRITE(numout,*) ' jl, ice volume content ', jl 
     333            WRITE(numout,*) ' sxice  ', sxice(ji,jj,jl) 
     334            WRITE(numout,*) ' syice  ', syice(ji,jj,jl) 
     335            WRITE(numout,*) ' sxxice ', sxxice(ji,jj,jl) 
     336            WRITE(numout,*) ' syyice ', syyice(ji,jj,jl) 
     337            WRITE(numout,*) ' sxyice ', sxyice(ji,jj,jl) 
     338            WRITE(numout,*) ' jl, snow volume content ', jl 
     339            WRITE(numout,*) ' sxsn   ', sxsn(ji,jj,jl) 
     340            WRITE(numout,*) ' sysn   ', sysn(ji,jj,jl) 
     341            WRITE(numout,*) ' sxxsn  ', sxxsn(ji,jj,jl) 
     342            WRITE(numout,*) ' syysn  ', syysn(ji,jj,jl) 
     343            WRITE(numout,*) ' sxysn  ', sxysn(ji,jj,jl) 
     344            WRITE(numout,*) ' jl, ice area in category ', jl 
     345            WRITE(numout,*) ' sxa    ', sxa (ji,jj,jl) 
     346            WRITE(numout,*) ' sya    ', sya (ji,jj,jl) 
     347            WRITE(numout,*) ' sxxa   ', sxxa (ji,jj,jl) 
     348            WRITE(numout,*) ' syya   ', syya (ji,jj,jl) 
     349            WRITE(numout,*) ' sxya   ', sxya (ji,jj,jl) 
     350            WRITE(numout,*) ' jl, snow temp ', jl 
     351            WRITE(numout,*) ' sxc0   ', sxc0(ji,jj,jl) 
     352            WRITE(numout,*) ' syc0   ', syc0(ji,jj,jl) 
     353            WRITE(numout,*) ' sxxc0  ', sxxc0(ji,jj,jl) 
     354            WRITE(numout,*) ' syyc0  ', syyc0(ji,jj,jl) 
     355            WRITE(numout,*) ' sxyc0  ', sxyc0(ji,jj,jl) 
     356            WRITE(numout,*) ' jl, ice salinity ', jl 
     357            WRITE(numout,*) ' sxsal  ', sxsal(ji,jj,jl) 
     358            WRITE(numout,*) ' sysal  ', sysal(ji,jj,jl) 
     359            WRITE(numout,*) ' sxxsal ', sxxsal(ji,jj,jl) 
     360            WRITE(numout,*) ' syysal ', syysal(ji,jj,jl) 
     361            WRITE(numout,*) ' sxysal ', sxysal(ji,jj,jl) 
     362            WRITE(numout,*) ' jl, ice age      ', jl 
     363            WRITE(numout,*) ' sxage  ', sxage(ji,jj,jl) 
     364            WRITE(numout,*) ' syage  ', syage(ji,jj,jl) 
     365            WRITE(numout,*) ' sxxage ', sxxage(ji,jj,jl) 
     366            WRITE(numout,*) ' syyage ', syyage(ji,jj,jl) 
     367            WRITE(numout,*) ' sxyage ', sxyage(ji,jj,jl) 
     368         END DO 
     369         DO jl = 1, jpl 
     370            DO jk = 1, nlay_i 
     371               WRITE(numout,*) ' jk, jl, ice heat content', jk, jl 
     372               WRITE(numout,*) ' sxe    ', sxe(ji,jj,jk,jl) 
     373               WRITE(numout,*) ' sye    ', sye(ji,jj,jk,jl) 
     374               WRITE(numout,*) ' sxxe   ', sxxe(ji,jj,jk,jl) 
     375               WRITE(numout,*) ' syye   ', syye(ji,jj,jk,jl) 
     376               WRITE(numout,*) ' sxye   ', sxye(ji,jj,jk,jl) 
     377            END DO 
     378         END DO 
     379 
     380      ENDIF 
     381 
     382   END SUBROUTINE lim_rst_write 
     383 
    384384   SUBROUTINE lim_rst_read 
    385385      !!---------------------------------------------------------------------- 
    … …  
    398398      CHARACTER(len=1) :: zchar, zchar1 
    399399      !!---------------------------------------------------------------------- 
    400     
     400 
    401401      IF(lwp) THEN 
    402402         WRITE(numout,*) 
    … …  
    413413 
    414414      !Control of date 
    415        
     415 
    416416      IF( ( nit000 - INT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   & 
    417417         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 in ice restart',  & 
    … …  
    461461         END DO 
    462462      END DO 
    463     
     463 
    464464      DO jk = 1, nlay_i 
    465465         s_i(:,:,jk,:) = sm_i(:,:,:) 
    466466      END DO 
    467     
     467 
    468468      ! Salinity profile 
    469469      !----------------- 
    470470      WRITE(numout,*) ' num_sal - will restart understand salinity profile ', num_sal 
    471     
     471 
    472472      num_sal = 2 
    473473      IF(num_sal.eq.2) THEN 
    474    !     CALL lim_var_salprof 
     474         !     CALL lim_var_salprof 
    475475         DO jl = 1, jpl 
    476476            DO jk = 1, nlay_i 
    … …  
    479479                     zs_inf        = sm_i(ji,jj,jl) 
    480480                     z_slope_s     = 2.0*sm_i(ji,jj,jl)/MAX(0.01,ht_i(ji,jj,jl)) 
    481                                      !- slope of the salinity profile 
     481                     !- slope of the salinity profile 
    482482                     zs_zero(jk)   = z_slope_s * ( FLOAT(jk)-1.0/2.0 ) * & 
    483                                                   ht_i(ji,jj,jl) / FLOAT(nlay_i) 
     483                        ht_i(ji,jj,jl) / FLOAT(nlay_i) 
    484484                     zsmax = 4.5 
    485485                     zsmin = 3.5 
    … …  
    497497         END DO 
    498498      ENDIF 
    499           
     499 
    500500# if defined key_coupled  
    501501      CALL iom_get( numrir, jpdom_autoglo, 'albege'   , albege ) 
    … …  
    507507         e_s(:,:,1,jl) = z2d(:,:) 
    508508      END DO 
    509     
     509 
    510510      DO jl = 1, jpl  
    511511         WRITE(zchar,'(I1)') jl 
    … …  
    651651      CALL iom_close( numrir ) 
    652652 
    653    !+++++++++++ CHECK EVERYTHING ++++++++++ 
    654     
    655                WRITE(numout,*) 
    656                WRITE(numout,*) ' lim_rst_read  : CHUKCHI SEA POINT ' 
    657                WRITE(numout,*) ' ~~~~~~~~~~' 
    658                WRITE(numout,*) ' ~~~ Arctic' 
    659     
    660                indx = 1 
    661                ji = 24 
    662                jj = 24 
    663                WRITE(numout,*) ' ji, jj ', ji, jj 
    664                WRITE(numout,*) ' ICE VARIABLES ' 
    665                WRITE(numout,*) ' open water ', ato_i(ji,jj) 
    666     
    667                DO jl = 1, jpl 
    668                   WRITE(numout,*) ' *** CATEGORY NUMBER *** ', jl 
    669                   WRITE(numout,*) ' ' 
    670                   WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)      
    671                   WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)  
    672                   WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)     
    673                   WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9       
    674                   WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9       
    675                   WRITE(numout,*) ' e_s        : ', e_s(ji,jj,1,jl)       
    676                   WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)   
    677                   WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl) 
    678                   WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl) 
    679                END DO 
    680     
    681                WRITE(numout,*) ' open water ' 
    682                WRITE(numout,*) ' sxopw  ', sxopw(ji,jj) 
    683                WRITE(numout,*) ' syopw  ', syopw(ji,jj) 
    684                WRITE(numout,*) ' sxxopw ', sxxopw(ji,jj) 
    685                WRITE(numout,*) ' syyopw ', syyopw(ji,jj) 
    686                WRITE(numout,*) ' sxyopw ', sxyopw(ji,jj) 
    687                DO jl = 1, jpl 
    688                   WRITE(numout,*) ' jl, ice volume content ', jl 
    689                   WRITE(numout,*) ' sxice  ', sxice(ji,jj,jl) 
    690                   WRITE(numout,*) ' syice  ', syice(ji,jj,jl) 
    691                   WRITE(numout,*) ' sxxice ', sxxice(ji,jj,jl) 
    692                   WRITE(numout,*) ' syyice ', syyice(ji,jj,jl) 
    693                   WRITE(numout,*) ' sxyice ', sxyice(ji,jj,jl) 
    694                   WRITE(numout,*) ' jl, snow volume content ', jl 
    695                   WRITE(numout,*) ' sxsn   ', sxsn(ji,jj,jl) 
    696                   WRITE(numout,*) ' sysn   ', sysn(ji,jj,jl) 
    697                   WRITE(numout,*) ' sxxsn  ', sxxsn(ji,jj,jl) 
    698                   WRITE(numout,*) ' syysn  ', syysn(ji,jj,jl) 
    699                   WRITE(numout,*) ' sxysn  ', sxysn(ji,jj,jl) 
    700                   WRITE(numout,*) ' jl, ice area in category ', jl 
    701                   WRITE(numout,*) ' sxa    ', sxa (ji,jj,jl) 
    702                   WRITE(numout,*) ' sya    ', sya (ji,jj,jl) 
    703                   WRITE(numout,*) ' sxxa   ', sxxa (ji,jj,jl) 
    704                   WRITE(numout,*) ' syya   ', syya (ji,jj,jl) 
    705                   WRITE(numout,*) ' sxya   ', sxya (ji,jj,jl) 
    706                   WRITE(numout,*) ' jl, snow temp ', jl 
    707                   WRITE(numout,*) ' sxc0   ', sxc0(ji,jj,jl) 
    708                   WRITE(numout,*) ' syc0   ', syc0(ji,jj,jl) 
    709                   WRITE(numout,*) ' sxxc0  ', sxxc0(ji,jj,jl) 
    710                   WRITE(numout,*) ' syyc0  ', syyc0(ji,jj,jl) 
    711                   WRITE(numout,*) ' sxyc0  ', sxyc0(ji,jj,jl) 
    712                   WRITE(numout,*) ' jl, ice salinity ', jl 
    713                   WRITE(numout,*) ' sxsal  ', sxsal(ji,jj,jl) 
    714                   WRITE(numout,*) ' sysal  ', sysal(ji,jj,jl) 
    715                   WRITE(numout,*) ' sxxsal ', sxxsal(ji,jj,jl) 
    716                   WRITE(numout,*) ' syysal ', syysal(ji,jj,jl) 
    717                   WRITE(numout,*) ' sxysal ', sxysal(ji,jj,jl) 
    718                   WRITE(numout,*) ' jl, ice age      ', jl 
    719                   WRITE(numout,*) ' sxage  ', sxage(ji,jj,jl) 
    720                   WRITE(numout,*) ' syage  ', syage(ji,jj,jl) 
    721                   WRITE(numout,*) ' sxxage ', sxxage(ji,jj,jl) 
    722                   WRITE(numout,*) ' syyage ', syyage(ji,jj,jl) 
    723                   WRITE(numout,*) ' sxyage ', sxyage(ji,jj,jl) 
    724                END DO 
    725                DO jl = 1, jpl 
    726                   DO jk = 1, nlay_i 
    727                      WRITE(numout,*) ' jk, jl, ice heat content', jk, jl 
    728                      WRITE(numout,*) ' sxe    ', sxe(ji,jj,jk,jl) 
    729                      WRITE(numout,*) ' sye    ', sye(ji,jj,jk,jl) 
    730                      WRITE(numout,*) ' sxxe   ', sxxe(ji,jj,jk,jl) 
    731                      WRITE(numout,*) ' syye   ', syye(ji,jj,jk,jl) 
    732                      WRITE(numout,*) ' sxye   ', sxye(ji,jj,jk,jl) 
    733                   END DO 
    734                END DO 
    735     
    736    !+++++++++++ END CHECK +++++++++++++++++ 
    737     
    738       END SUBROUTINE lim_rst_read 
    739     
    740     
     653      !+++++++++++ CHECK EVERYTHING ++++++++++ 
     654 
     655      WRITE(numout,*) 
     656      WRITE(numout,*) ' lim_rst_read  : CHUKCHI SEA POINT ' 
     657      WRITE(numout,*) ' ~~~~~~~~~~' 
     658      WRITE(numout,*) ' ~~~ Arctic' 
     659 
     660      indx = 1 
     661      ji = 24 
     662      jj = 24 
     663      WRITE(numout,*) ' ji, jj ', ji, jj 
     664      WRITE(numout,*) ' ICE VARIABLES ' 
     665      WRITE(numout,*) ' open water ', ato_i(ji,jj) 
     666 
     667      DO jl = 1, jpl 
     668         WRITE(numout,*) ' *** CATEGORY NUMBER *** ', jl 
     669         WRITE(numout,*) ' ' 
     670         WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)      
     671         WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)  
     672         WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)     
     673         WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9       
     674         WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9       
     675         WRITE(numout,*) ' e_s        : ', e_s(ji,jj,1,jl)       
     676         WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)   
     677         WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl) 
     678         WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl) 
     679      END DO 
     680 
     681      WRITE(numout,*) ' open water ' 
     682      WRITE(numout,*) ' sxopw  ', sxopw(ji,jj) 
     683      WRITE(numout,*) ' syopw  ', syopw(ji,jj) 
     684      WRITE(numout,*) ' sxxopw ', sxxopw(ji,jj) 
     685      WRITE(numout,*) ' syyopw ', syyopw(ji,jj) 
     686      WRITE(numout,*) ' sxyopw ', sxyopw(ji,jj) 
     687      DO jl = 1, jpl 
     688         WRITE(numout,*) ' jl, ice volume content ', jl 
     689         WRITE(numout,*) ' sxice  ', sxice(ji,jj,jl) 
     690         WRITE(numout,*) ' syice  ', syice(ji,jj,jl) 
     691         WRITE(numout,*) ' sxxice ', sxxice(ji,jj,jl) 
     692         WRITE(numout,*) ' syyice ', syyice(ji,jj,jl) 
     693         WRITE(numout,*) ' sxyice ', sxyice(ji,jj,jl) 
     694         WRITE(numout,*) ' jl, snow volume content ', jl 
     695         WRITE(numout,*) ' sxsn   ', sxsn(ji,jj,jl) 
     696         WRITE(numout,*) ' sysn   ', sysn(ji,jj,jl) 
     697         WRITE(numout,*) ' sxxsn  ', sxxsn(ji,jj,jl) 
     698         WRITE(numout,*) ' syysn  ', syysn(ji,jj,jl) 
     699         WRITE(numout,*) ' sxysn  ', sxysn(ji,jj,jl) 
     700         WRITE(numout,*) ' jl, ice area in category ', jl 
     701         WRITE(numout,*) ' sxa    ', sxa (ji,jj,jl) 
     702         WRITE(numout,*) ' sya    ', sya (ji,jj,jl) 
     703         WRITE(numout,*) ' sxxa   ', sxxa (ji,jj,jl) 
     704         WRITE(numout,*) ' syya   ', syya (ji,jj,jl) 
     705         WRITE(numout,*) ' sxya   ', sxya (ji,jj,jl) 
     706         WRITE(numout,*) ' jl, snow temp ', jl 
     707         WRITE(numout,*) ' sxc0   ', sxc0(ji,jj,jl) 
     708         WRITE(numout,*) ' syc0   ', syc0(ji,jj,jl) 
     709         WRITE(numout,*) ' sxxc0  ', sxxc0(ji,jj,jl) 
     710         WRITE(numout,*) ' syyc0  ', syyc0(ji,jj,jl) 
     711         WRITE(numout,*) ' sxyc0  ', sxyc0(ji,jj,jl) 
     712         WRITE(numout,*) ' jl, ice salinity ', jl 
     713         WRITE(numout,*) ' sxsal  ', sxsal(ji,jj,jl) 
     714         WRITE(numout,*) ' sysal  ', sysal(ji,jj,jl) 
     715         WRITE(numout,*) ' sxxsal ', sxxsal(ji,jj,jl) 
     716         WRITE(numout,*) ' syysal ', syysal(ji,jj,jl) 
     717         WRITE(numout,*) ' sxysal ', sxysal(ji,jj,jl) 
     718         WRITE(numout,*) ' jl, ice age      ', jl 
     719         WRITE(numout,*) ' sxage  ', sxage(ji,jj,jl) 
     720         WRITE(numout,*) ' syage  ', syage(ji,jj,jl) 
     721         WRITE(numout,*) ' sxxage ', sxxage(ji,jj,jl) 
     722         WRITE(numout,*) ' syyage ', syyage(ji,jj,jl) 
     723         WRITE(numout,*) ' sxyage ', sxyage(ji,jj,jl) 
     724      END DO 
     725      DO jl = 1, jpl 
     726         DO jk = 1, nlay_i 
     727            WRITE(numout,*) ' jk, jl, ice heat content', jk, jl 
     728            WRITE(numout,*) ' sxe    ', sxe(ji,jj,jk,jl) 
     729            WRITE(numout,*) ' sye    ', sye(ji,jj,jk,jl) 
     730            WRITE(numout,*) ' sxxe   ', sxxe(ji,jj,jk,jl) 
     731            WRITE(numout,*) ' syye   ', syye(ji,jj,jk,jl) 
     732            WRITE(numout,*) ' sxye   ', sxye(ji,jj,jk,jl) 
     733         END DO 
     734      END DO 
     735 
     736      !+++++++++++ END CHECK +++++++++++++++++ 
     737 
     738   END SUBROUTINE lim_rst_read 
     739 
     740 
    741741#else 
    742742   !!---------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_3/limsbc.F90

    r918 r921  
    8383      REAL(wp) ::   zat_u, zu_ico, zutaui, zu_u, zv_u, zmodu, zmod 
    8484      REAL(wp) ::   zat_v, zv_ico, zvtaui, zu_v, zv_v, zmodv, zsang 
    85        
     85 
    8686#if defined key_coupled     
    8787      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb     ! albedo of ice under overcast sky 
    8888      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalbp    ! albedo of ice under clear sky 
    8989#endif 
    90      REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! ocean stress below sea-ice 
     90      REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! ocean stress below sea-ice 
    9191      !!--------------------------------------------------------------------- 
    92       
     92 
    9393      IF( kt == nit000 ) THEN 
    9494         IF(lwp) WRITE(numout,*) 
    … …  
    9898 
    9999      SELECT CASE( kcpl ) 
    100       !                                           !--------------------------------! 
     100         !                                           !--------------------------------! 
    101101      CASE( 0 )                                   !  LIM 3 old stress computation  !  (at ice timestep only) 
    102102         !                                        !--------------------------------!  
    … …  
    191191               zat_v = at_i(ji,jj) + at_i(ji,jj+1) * 0.5  
    192192 
    193 !!gm bug mixing U and V points value below     ====>>> to be corrected 
     193               !!gm bug mixing U and V points value below     ====>>> to be corrected 
    194194               zu_ico   = u_ice(ji,jj) - 0.5 * ( un(ji,jj,1) - ssu_m(ji,jj) )   ! ice-oce velocity using un and ssu_m 
    195195               zv_ico   = v_ice(ji,jj) - 0.5 * ( vn(ji,jj,1) - ssu_m(ji,jj) ) 
    … …  
    199199               zutaui   = rhoco * zmod * ( cangvg * zu_ico - zsang * zv_ico ) 
    200200               zvtaui   = rhoco * zmod * ( cangvg * zv_ico + zsang * zu_ico ) 
    201 ! 
     201               ! 
    202202               utau(ji,jj) = ( 1.-zat_u ) * utau_oce(ji,jj) + zat_u * zutaui    ! stress at the ocean surface 
    203203               vtau(ji,jj) = ( 1.-zat_v ) * vtau_oce(ji,jj) + zat_v * zvtaui 
    … …  
    247247#endif 
    248248      !!--------------------------------------------------------------------- 
    249       
     249 
    250250      IF( kt == nit000 ) THEN 
    251251         IF(lwp) WRITE(numout,*) 
    … …  
    259259      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    260260      ! changed to old_frld and old ht_i 
    261         
     261 
    262262      DO jj = 1, jpj 
    263263         DO ji = 1, jpi 
    … …  
    286286            !   computation the solar flux at ocean surface 
    287287            zfcm1(ji,jj)   = pfrld(ji,jj) * qsr(ji,jj)  + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 
    288                 ! fstric     Solar flux transmitted trough the ice 
    289                 ! qsr        Net short wave heat flux on free ocean 
    290 ! new line 
     288            ! fstric     Solar flux transmitted trough the ice 
     289            ! qsr        Net short wave heat flux on free ocean 
     290            ! new line 
    291291            fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 
    292292 
    … …  
    294294            zfcm2(ji,jj) = - zfcm1(ji,jj)                  & 
    295295               &           + iflt    * ( fscmbq(ji,jj) )   & ! total abl -> fscmbq is given to the ocean 
    296 ! fscmbq and ffltbif are obsolete 
    297 !              &           + iflt * ffltbif(ji,jj) !!! only if one category is used 
     296               ! fscmbq and ffltbif are obsolete 
     297               !              &           + iflt * ffltbif(ji,jj) !!! only if one category is used 
    298298               &           + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) / rdt_ice   & 
    299299               &           + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) / rdt_ice                     & 
    … …  
    301301               &           + fheat_rpo(ji,jj) & ! contribution from ridge formation 
    302302               &           + fheat_res(ji,jj) 
    303                 ! fscmbq  Part of the solar radiation transmitted through the ice and going to the ocean 
    304                 !         computed in limthd_zdf.F90 
    305                 ! ffltbif Total heat content of the ice (brine pockets+ice) / delta_t 
    306                 ! qcmif   Energy needed to bring the ocean surface layer until its freezing (ok) 
    307                 ! qldif   heat balance of the lead (or of the open ocean) 
    308                 ! qfvbq   i think this is wrong! 
    309                 ! ---> Array used to store energy in case of total lateral ablation 
    310                 ! qfvbq latent heat uptake/release after accretion/ablation 
    311                 ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 
     303            ! fscmbq  Part of the solar radiation transmitted through the ice and going to the ocean 
     304            !         computed in limthd_zdf.F90 
     305            ! ffltbif Total heat content of the ice (brine pockets+ice) / delta_t 
     306            ! qcmif   Energy needed to bring the ocean surface layer until its freezing (ok) 
     307            ! qldif   heat balance of the lead (or of the open ocean) 
     308            ! qfvbq   i think this is wrong! 
     309            ! ---> Array used to store energy in case of total lateral ablation 
     310            ! qfvbq latent heat uptake/release after accretion/ablation 
     311            ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 
    312312 
    313313            IF ( num_sal .EQ. 2 ) zfcm2(ji,jj) = zfcm2(ji,jj) + & 
    314                                   fhbri(ji,jj) ! new contribution due to brine drainage  
     314               fhbri(ji,jj) ! new contribution due to brine drainage  
    315315 
    316316            ! bottom radiative component is sent to the computation of the 
    … …  
    321321            qsr(ji,jj) = zfcm1(ji,jj)                                       ! solar heat flux  
    322322            qns(ji,jj) = zfcm2(ji,jj) - fdtcn(ji,jj)                        ! non solar heat flux 
    323 !                           ! fdtcn : turbulent oceanic heat flux 
    324  
    325 !!gm   this IF prevents the vertorisation of the whole loop 
     323            !                           ! fdtcn : turbulent oceanic heat flux 
     324 
     325            !!gm   this IF prevents the vertorisation of the whole loop 
    326326            IF ( ( ji .EQ. jiindx ) .AND. ( jj .EQ. jjindx) ) THEN 
    327327               WRITE(numout,*) ' lim_sbc : heat fluxes ' 
    … …  
    352352               WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) 
    353353            ENDIF 
    354 !!gm   end 
     354            !!gm   end 
    355355         END DO 
    356356      END DO 
    357         
     357 
    358358      !------------------------------------------! 
    359359      !      mass flux at the ocean surface      ! 
    360360      !------------------------------------------! 
    361361 
    362 !!gm   optimisation: this loop have to be merged with the previous one 
     362      !!gm   optimisation: this loop have to be merged with the previous one 
    363363      DO jj = 1, jpj 
    364364         DO ji = 1, jpi 
    … …  
    375375            zpme = - emp(ji,jj)     * ( 1.0 - at_i(ji,jj) )  &   !  evaporation over oceanic fraction 
    376376               &   + tprecip(ji,jj) *         at_i(ji,jj)    &   !  total precipitation 
    377 ! old fashioned way                
    378 !              &   - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )  &   !  remov. snow precip over ice 
     377               ! old fashioned way                
     378               !              &   - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )  &   !  remov. snow precip over ice 
    379379               &   - sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   !  remov. snow precip over ice 
    380380               &   - rdmsnif(ji,jj) / rdt_ice                &   !  freshwaterflux due to snow melting  
    381 ! new contribution from snow falling when ridging 
     381               ! new contribution from snow falling when ridging 
    382382               &   + fmmec(ji,jj) 
    383              
     383 
    384384            !  computing salt exchanges at the ice/ocean interface 
    385385            !  sice should be the same as computed with the ice model 
    386386            zfons =  ( soce - sice ) * ( rdmicif(ji,jj) / rdt_ice )  
    387 ! SOCE 
     387            ! SOCE 
    388388            zfons =  ( sss_m(ji,jj) - sice ) * ( rdmicif(ji,jj) / rdt_ice )  
    389              
    390 !CT useless            !  salt flux for constant salinity 
    391 !CT useless            fsalt(ji,jj)      =  zfons / ( sss_m(ji,jj) + epsi16 ) + fsalt_res(ji,jj) 
     389 
     390            !CT useless            !  salt flux for constant salinity 
     391            !CT useless            fsalt(ji,jj)      =  zfons / ( sss_m(ji,jj) + epsi16 ) + fsalt_res(ji,jj) 
    392392            !  salt flux for variable salinity 
    393393            zinda             = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    … …  
    415415         emps(:,:) =              fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) + emp(:,:) 
    416416      ENDIF 
    417        
     417 
    418418      IF( lk_dynspg_rl )    emp (:,:) = emps(:,:)      ! rigid-lid formulation : emp = emps 
    419419 
    … …  
    442442         CALL prt_ctl( tab2d_1=freeze, clinfo1=' lim_sbc: freeze : ' ) 
    443443         CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 
    444       ENDIF  
     444      ENDIF 
    445445      !  
    446446   END SUBROUTINE lim_sbc_flx 

  • trunk/NEMO/LIM_SRC_3/limtab.F90

    r888 r921  
    4444      INTEGER ::  & 
    4545         jn , jid, jjd 
    46          
     46 
    4747      DO jn = 1, ndim1d 
    4848         jid        = MOD( tab_ind(jn) - 1, ndim2d_x ) + 1 
    4949         jjd        = ( tab_ind(jn) - 1 ) / ndim2d_x + 1 
    5050         tab1d( jn) = tab2d( jid, jjd) 
    51       END DO  
     51      END DO 
    5252 
    5353   END SUBROUTINE tab_2d_1d 

  • trunk/NEMO/LIM_SRC_3/limthd.F90

    r888 r921  
    3939   PUBLIC lim_thd         ! called by lim_step 
    4040 
    41   !! * Module variables 
    42      REAL(wp)  ::            &  ! constant values 
    43          epsi20 = 1e-20   ,  & 
    44          epsi16 = 1e-16   ,  & 
    45          epsi06 = 1e-06   ,  & 
    46          epsi04 = 1e-04   ,  & 
    47          zzero  = 0.e0     , & 
    48          zone   = 1.e0 
     41   !! * Module variables 
     42   REAL(wp)  ::            &  ! constant values 
     43      epsi20 = 1e-20   ,  & 
     44      epsi16 = 1e-16   ,  & 
     45      epsi06 = 1e-06   ,  & 
     46      epsi04 = 1e-04   ,  & 
     47      zzero  = 0.e0     , & 
     48      zone   = 1.e0 
    4949 
    5050   !! * Substitutions 
    … …  
    5959CONTAINS 
    6060 
    61    SUBROUTINE lim_thd 
     61   SUBROUTINE lim_thd( kt ) 
    6262      !!------------------------------------------------------------------- 
    6363      !!                ***  ROUTINE lim_thd  ***        
    … …  
    8484      !!                                     salinity variations 
    8585      !!--------------------------------------------------------------------- 
     86      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    8687      !! * Local variables 
    8788      INTEGER  ::  ji, jj, jk, jl, nbpb   ! nb of icy pts for thermo. cal. 
    … …  
    9091         zfric_umin = 5e-03 ,  &   ! lower bound for the friction velocity 
    9192         zfric_umax = 2e-02        ! upper bound for the friction velocity 
    92        
     93 
    9394      REAL(wp) ::   & 
    9495         zinda              ,  &   ! switch for test. the val. of concen. 
    … …  
    103104      REAL(wp) ::   & 
    104105         zareamin 
    105           
     106 
    106107      REAL(wp), DIMENSION(jpi,jpj) :: & 
    107108         zhicifp            ,  &   ! ice thickness for outputs 
    … …  
    112113      IF( numit == nstart  )   CALL lim_thd_init  ! Initialization (first time-step only) 
    113114 
    114       WRITE(numout,*) 'limthd : Ice Thermodynamics' 
    115       WRITE(numout,*) '~~~~~~' 
     115      IF( kt == nit000 .AND. lwp ) THEN 
     116         WRITE(numout,*) 'limthd : Ice Thermodynamics' 
     117         WRITE(numout,*) '~~~~~~' 
     118      ENDIF 
    116119 
    117120      IF( numit == nstart  )   CALL lim_thd_sal_init  ! Initialization (first time-step only) 
    118 !------------------------------------------------------------------------------! 
    119 ! 1) Initialization of diagnostic variables                                    ! 
    120 !------------------------------------------------------------------------------! 
     121      !------------------------------------------------------------------------------! 
     122      ! 1) Initialization of diagnostic variables                                    ! 
     123      !------------------------------------------------------------------------------! 
    121124      zeps = 1.0e-10 
    122125      tatm_ice(:,:) = tatm_ice(:,:) + 273.15 ! convert C to K 
    … …  
    129132 
    130133      DO jl = 1, jpl 
    131         DO jk = 1, nlay_i 
    132           DO jj = 1, jpj 
    133             DO ji = 1, jpi 
    134                !Energy of melting q(S,T) [J.m-3] 
    135                e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / area(ji,jj) / &  
    136                                   MAX( v_i(ji,jj,jl) , epsi06 ) * nlay_i 
    137                !0 if no ice and 1 if yes 
    138                zindb            = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_i(ji,jj,jl) ) )  
    139                !convert units ! very important that this line is here 
    140                e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb  
     134         DO jk = 1, nlay_i 
     135            DO jj = 1, jpj 
     136               DO ji = 1, jpi 
     137                  !Energy of melting q(S,T) [J.m-3] 
     138                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / area(ji,jj) / &  
     139                     MAX( v_i(ji,jj,jl) , epsi06 ) * nlay_i 
     140                  !0 if no ice and 1 if yes 
     141                  zindb            = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_i(ji,jj,jl) ) )  
     142                  !convert units ! very important that this line is here 
     143                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb  
     144               END DO 
    141145            END DO 
    142           END DO 
    143         END DO 
     146         END DO 
    144147      END DO 
    145148 
    146149      DO jl = 1, jpl 
    147         DO jk = 1, nlay_s 
    148           DO jj = 1, jpj 
    149             DO ji = 1, jpi 
    150                !Energy of melting q(S,T) [J.m-3] 
    151                e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / area(ji,jj) / &  
    152                                   MAX( v_s(ji,jj,jl) , epsi06 ) * nlay_s 
    153                !0 if no ice and 1 if yes 
    154                zindb            = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s(ji,jj,jl) ) )  
    155                !convert units ! very important that this line is here 
    156                e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac * zindb  
     150         DO jk = 1, nlay_s 
     151            DO jj = 1, jpj 
     152               DO ji = 1, jpi 
     153                  !Energy of melting q(S,T) [J.m-3] 
     154                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / area(ji,jj) / &  
     155                     MAX( v_s(ji,jj,jl) , epsi06 ) * nlay_s 
     156                  !0 if no ice and 1 if yes 
     157                  zindb            = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s(ji,jj,jl) ) )  
     158                  !convert units ! very important that this line is here 
     159                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac * zindb  
     160               END DO 
    157161            END DO 
    158           END DO 
    159         END DO 
     162         END DO 
    160163      END DO 
    161164 
    … …  
    187190      fatm(:,:) = 0.e0 
    188191 
    189 ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
    190 !-----------------------------------------------------------------------------! 
    191  
    192 !     !CDIR NOVERRCHK 
    193          DO jj = 1, jpj 
    194 !        !CDIR NOVERRCHK 
    195             DO ji = 1, jpi 
     192      ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
     193      !-----------------------------------------------------------------------------! 
     194 
     195!CDIR NOVERRCHK 
     196      DO jj = 1, jpj 
     197!CDIR NOVERRCHK 
     198         DO ji = 1, jpi 
    196199            zthsnice       = SUM( ht_s(ji,jj,1:jpl) ) + SUM( ht_i(ji,jj,1:jpl) ) 
    197200            zindb          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - zthsnice ) ) )  
    … …  
    199202            pfrld(ji,jj)   = 1.0 - at_i(ji,jj) 
    200203            zinda          = 1.0 - MAX( zzero , SIGN( zone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    201              
    202 !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
    203 !           !  practically no "direct lateral ablation" 
    204 !            
    205 !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
    206 !           !  temperature and turbulent mixing (McPhee, 1992) 
     204 
     205            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
     206            !           !  practically no "direct lateral ablation" 
     207            !            
     208            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
     209            !           !  temperature and turbulent mixing (McPhee, 1992) 
    207210            ! friction velocity 
    208211            zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )  
    … …  
    211214            fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( (sst_m(ji,jj) + rt0) - t_bo(ji,jj) )  
    212215            ! also category dependent 
    213 !           !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead  
     216            !           !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead  
    214217            qdtcn(ji,jj)  = zindb * fdtcn(ji,jj) * (1.0 - at_i(ji,jj)) * rdt_ice 
    215 !                        
    216  
    217 ! still need to be updated : fdtcn !!!! 
    218 !           !-- Lead heat budget (part 1, next one is in limthd_dh 
    219 !           !-- qldif -- (or qldif_1d in 1d routines) 
     218            !                        
     219 
     220            ! still need to be updated : fdtcn !!!! 
     221            !           !-- Lead heat budget (part 1, next one is in limthd_dh 
     222            !           !-- qldif -- (or qldif_1d in 1d routines) 
    220223            zfontn         = sprecip(ji,jj) * lfus              ! energy of melting 
    221224            zfnsol         = qns(ji,jj)                         ! total non solar flux 
    … …  
    232235            !false 
    233236            zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / & 
    234                              MAX( at_i(ji,jj) * rdt_ice , epsi16 ) 
     237               MAX( at_i(ji,jj) * rdt_ice , epsi16 ) 
    235238 
    236239            ! Heat budget of the lead, energy transferred from ice to ocean 
    … …  
    244247            !  calculate oceanic heat flux (limthd_dh) 
    245248            fbif   (ji,jj) = zindb * (  fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi20 ) + fdtcn(ji,jj) ) 
    246              
     249 
    247250            ! computation of the daily thermodynamic ice production (only needed for output) 
    248251            zhicifp(ji,jj) = ht_i(ji,jj,1) * at_i(ji,jj)  
    … …  
    251254      END DO 
    252255 
    253 !------------------------------------------------------------------------------! 
    254 ! 3) Select icy points and fulfill arrays for the vectorial grid.             
    255 !------------------------------------------------------------------------------! 
     256      !------------------------------------------------------------------------------! 
     257      ! 3) Select icy points and fulfill arrays for the vectorial grid.             
     258      !------------------------------------------------------------------------------! 
    256259 
    257260      DO jl = 1, jpl      !loop over ice categories 
    258261 
    259          WRITE(numout,*) ' lim_thd : transfer to 1D vectors. Category no : ', jl  
    260          WRITE(numout,*) ' ~~~~~~~~' 
     262         IF( kt == nit000 .AND. lwp ) THEN 
     263            WRITE(numout,*) ' lim_thd : transfer to 1D vectors. Category no : ', jl  
     264            WRITE(numout,*) ' ~~~~~~~~' 
     265         ENDIF 
    261266 
    262267         zareamin = 1.0e-10 
    … …  
    270275               ! debug point to follow 
    271276               IF ( (ji.eq.jiindx).AND.(jj.eq.jjindx) ) THEN 
    272                    jiindex_1d = nbpb 
     277                  jiindex_1d = nbpb 
    273278               ENDIF 
    274279            END DO 
    275280         END DO 
    276281 
    277 !------------------------------------------------------------------------------! 
    278 ! 4) Thermodynamic computation 
    279 !------------------------------------------------------------------------------! 
     282         !------------------------------------------------------------------------------! 
     283         ! 4) Thermodynamic computation 
     284         !------------------------------------------------------------------------------! 
    280285 
    281286         IF( lk_mpp ) CALL mpp_ini_ice(nbpb) 
    … …  
    283288         IF (nbpb > 0) THEN  ! If there is no ice, do nothing. 
    284289 
    285          !------------------------- 
    286          ! 4.1 Move to 1D arrays 
    287          !------------------------- 
     290            !------------------------- 
     291            ! 4.1 Move to 1D arrays 
     292            !------------------------- 
    288293 
    289294            CALL tab_2d_1d( nbpb, at_i_b     (1:nbpb)     , at_i            , jpi, jpj, npb(1:nbpb) ) 
    … …  
    330335            CALL tab_2d_1d( nbpb, qfvbq_1d   (1:nbpb)     , qfvbq      , jpi, jpj, npb(1:nbpb) ) 
    331336 
    332          !-------------------------------- 
    333          ! 4.3) Thermodynamic processes 
    334          !-------------------------------- 
    335              
     337            !-------------------------------- 
     338            ! 4.3) Thermodynamic processes 
     339            !-------------------------------- 
     340 
    336341            IF ( con_i ) CALL lim_thd_enmelt(1,nbpb)   ! computes sea ice energy of melting 
    337342            IF ( con_i ) CALL lim_thd_glohec( qt_i_in , qt_s_in ,             & 
    338                                               q_i_layer_in , 1 , nbpb , jl ) 
    339                                                                
    340                                           !---------------------------------! 
     343               q_i_layer_in , 1 , nbpb , jl ) 
     344 
     345            !---------------------------------! 
    341346            CALL lim_thd_dif(1,nbpb,jl)   ! Ice/Snow Temperature profile    ! 
    342                                           !---------------------------------! 
     347            !---------------------------------! 
    343348 
    344349            CALL lim_thd_enmelt(1,nbpb)   ! computes sea ice energy of melting 
    345                                           ! compulsory for limthd_dh 
     350            ! compulsory for limthd_dh 
    346351 
    347352            IF ( con_i ) CALL lim_thd_glohec( qt_i_fin , qt_s_fin ,           & 
    348                                               q_i_layer_fin , 1 , nbpb , jl )  
     353               q_i_layer_fin , 1 , nbpb , jl )  
    349354            IF ( con_i ) CALL lim_thd_con_dif( 1 , nbpb , jl ) 
    350355 
    351                                           !---------------------------------! 
     356            !---------------------------------! 
    352357            CALL lim_thd_dh(1,nbpb,jl)    ! Ice/Snow thickness              !  
    353                                           !---------------------------------! 
    354  
    355                                           !---------------------------------! 
     358            !---------------------------------! 
     359 
     360            !---------------------------------! 
    356361            CALL lim_thd_ent(1,nbpb,jl)   ! Ice/Snow enthalpy remapping     ! 
    357                                           !---------------------------------! 
    358  
    359                                           !---------------------------------! 
     362            !---------------------------------! 
     363 
     364            !---------------------------------! 
    360365            CALL lim_thd_sal(1,nbpb)      ! Ice salinity computation        ! 
    361                                           !---------------------------------! 
    362  
    363 !           CALL lim_thd_enmelt(1,nbpb)   ! computes sea ice energy of melting 
     366            !---------------------------------! 
     367 
     368            !           CALL lim_thd_enmelt(1,nbpb)   ! computes sea ice energy of melting 
    364369            IF ( con_i ) CALL lim_thd_glohec( qt_i_fin, qt_s_fin,             & 
    365                                               q_i_layer_fin , 1 , nbpb , jl )  
     370               q_i_layer_fin , 1 , nbpb , jl )  
    366371            IF ( con_i ) CALL lim_thd_con_dh ( 1 , nbpb , jl ) 
    367372 
    368          !-------------------------------- 
    369          ! 4.4) Move 1D to 2D vectors 
    370          !-------------------------------- 
     373            !-------------------------------- 
     374            ! 4.4) Move 1D to 2D vectors 
     375            !-------------------------------- 
    371376 
    372377            CALL tab_1d_2d( nbpb, at_i        , npb, at_i_b (1:nbpb), jpi, jpj ) 
    … …  
    416421            !+++++ 
    417422 
    418          IF( lk_mpp ) CALL mpp_comm_free(ncomm_ice) !RB necessary ?? 
     423            IF( lk_mpp ) CALL mpp_comm_free(ncomm_ice) !RB necessary ?? 
    419424         ENDIF ! nbpb 
    420425 
    421426      END DO ! jl 
    422427 
    423 !------------------------------------------------------------------------------! 
    424 ! 5) Global variables, diagnostics 
    425 !------------------------------------------------------------------------------! 
     428      !------------------------------------------------------------------------------! 
     429      ! 5) Global variables, diagnostics 
     430      !------------------------------------------------------------------------------! 
    426431 
    427432      !------------------------ 
    … …  
    431436      ! Enthalpies are global variables we have to readjust the units 
    432437      DO jl = 1, jpl 
    433       DO jk = 1, nlay_i 
    434          DO jj = 1, jpj 
    435          DO ji = 1, jpi 
    436             ! Change dimensions 
    437             e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 
    438  
    439             ! Multiply by volume, divide by nlayers so that heat content in 10^9 Joules 
    440             e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * & 
    441                                area(ji,jj) * a_i(ji,jj,jl) * & 
    442                                ht_i(ji,jj,jl) / nlay_i 
    443          END DO !ji 
    444          END DO !jj 
    445       END DO !jk 
     438         DO jk = 1, nlay_i 
     439            DO jj = 1, jpj 
     440               DO ji = 1, jpi 
     441                  ! Change dimensions 
     442                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 
     443 
     444                  ! Multiply by volume, divide by nlayers so that heat content in 10^9 Joules 
     445                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * & 
     446                     area(ji,jj) * a_i(ji,jj,jl) * & 
     447                     ht_i(ji,jj,jl) / nlay_i 
     448               END DO !ji 
     449            END DO !jj 
     450         END DO !jk 
    446451      END DO !jl 
    447452 
    … …  
    459464                  ! Multiply by volume, so that heat content in 10^9 Joules 
    460465                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * & 
    461                                      a_i(ji,jj,jl) * ht_s(ji,jj,jl)  / nlay_s 
     466                     a_i(ji,jj,jl) * ht_s(ji,jj,jl)  / nlay_s 
    462467               END DO !ji 
    463468            END DO !jj 
    … …  
    513518   END SUBROUTINE lim_thd 
    514519 
    515 !=============================================================================== 
     520   !=============================================================================== 
    516521 
    517522   SUBROUTINE lim_thd_glohec(eti,ets,etilayer,kideb,kiut,jl) 
    … …  
    552557         DO ji = kideb, kiut 
    553558            etilayer(ji,jk) = q_i_b(ji,jk) & 
    554                             * ht_i_b(ji) / nlay_i 
     559               * ht_i_b(ji) / nlay_i 
    555560            eti(ji,jl) = eti(ji,jl) + etilayer(ji,jk)  
    556561         END DO 
    … …  
    567572      WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) / rdt_ice 
    568573      WRITE(numout,*) ' qt_in   : ', ( eti(jiindex_1d,jl) +         & 
    569                                      ets(jiindex_1d,jl) ) / rdt_ice 
     574         ets(jiindex_1d,jl) ) / rdt_ice 
    570575 
    571576   END SUBROUTINE lim_thd_glohec 
    572577 
    573 !=============================================================================== 
     578   !=============================================================================== 
    574579 
    575580   SUBROUTINE lim_thd_con_dif(kideb,kiut,jl) 
    … …  
    594599      INTEGER ::                    & 
    595600         numce                         !: number of points for which conservation 
    596                                        !  is violated 
     601      !  is violated 
    597602      INTEGER  :: & 
    598603         ji,jk,                     &  !: loop indices 
    … …  
    602607      max_cons_err =  1.0 
    603608      max_surf_err =  0.001 
    604              
     609 
    605610      !-------------------------- 
    606611      ! Increment of energy 
    … …  
    608613      ! global 
    609614      DO ji = kideb, kiut 
    610           dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl)  & 
    611                       + qt_s_fin(ji,jl) - qt_s_in(ji,jl) 
     615         dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl)  & 
     616            + qt_s_fin(ji,jl) - qt_s_in(ji,jl) 
    612617      END DO 
    613618      ! layer by layer 
    … …  
    619624 
    620625      DO ji = kideb, kiut 
    621           zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    622           zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    623  
    624           fatm(ji,jl) = & 
    625           qnsr_ice_1d(ji)                  + & ! atm non solar 
    626           (1.0-i0(ji))*qsr_ice_1d(ji)          ! atm solar 
    627  
    628           sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji)*i0(ji) & 
    629                            - fstroc(zji,zjj,jl) 
     626         zji                 = MOD( npb(ji) - 1, jpi ) + 1 
     627         zjj                 = ( npb(ji) - 1 ) / jpi + 1 
     628 
     629         fatm(ji,jl) = & 
     630            qnsr_ice_1d(ji)                  + & ! atm non solar 
     631            (1.0-i0(ji))*qsr_ice_1d(ji)          ! atm solar 
     632 
     633         sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji)*i0(ji) & 
     634            - fstroc(zji,zjj,jl) 
    630635      END DO 
    631636 
    … …  
    635640 
    636641      DO ji = kideb, kiut 
    637           cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) 
     642         cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) 
    638643      END DO 
    639644 
    … …  
    641646      meance = 0.0 
    642647      DO ji = kideb, kiut 
    643           IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 
    644               numce = numce + 1 
    645               meance = meance + cons_error(ji,jl) 
    646           ENDIF 
     648         IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 
     649            numce = numce + 1 
     650            meance = meance + cons_error(ji,jl) 
     651         ENDIF 
    647652      ENDDO 
    648653      IF (numce .GT. 0 ) meance = meance / numce 
    … …  
    651656      WRITE(numout,*) ' After lim_thd_dif, category : ', jl 
    652657      WRITE(numout,*) ' Mean conservation error on big error points ', meance, & 
    653       numit 
     658         numit 
    654659      WRITE(numout,*) ' Number of points where there is a cons err gt than c.e. : ', numce, numit 
    655660 
    … …  
    663668         surf_error(ji,jl) = ABS ( fatm(ji,jl) - fc_su(ji) ) 
    664669         IF ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. & 
    665                 max_surf_err ) ) THEN 
     670            max_surf_err ) ) THEN 
    666671            numce = numce + 1  
    667672            meance = meance + surf_error(ji,jl) 
    … …  
    685690      DO ji = kideb, kiut 
    686691         IF ( ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) .OR. & 
    687               ( cons_error(ji,jl) .GT. max_cons_err  ) ) THEN 
    688          zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    689          zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    690  
    691          WRITE(numout,*) ' alerte 1     ' 
    692          WRITE(numout,*) ' Untolerated conservation / surface error after ' 
    693          WRITE(numout,*) ' heat diffusion in the ice ' 
    694          WRITE(numout,*) ' Category   : ', jl 
    695          WRITE(numout,*) ' zji , zjj  : ', zji, zjj 
    696          WRITE(numout,*) ' lat, lon   : ', gphit(zji,zjj), glamt(zji,zjj) 
    697          WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
    698          WRITE(numout,*) ' surf_error : ', surf_error(ji,jl) 
    699          WRITE(numout,*) ' dq_i       : ', - dq_i(ji,jl) / rdt_ice 
    700          WRITE(numout,*) ' Fdt        : ', sum_fluxq(ji,jl) 
    701          WRITE(numout,*) 
    702 !        WRITE(numout,*) ' qt_i_in   : ', qt_i_in(ji,jl) 
    703 !        WRITE(numout,*) ' qt_s_in   : ', qt_s_in(ji,jl) 
    704 !        WRITE(numout,*) ' qt_i_fin  : ', qt_i_fin(ji,jl) 
    705 !        WRITE(numout,*) ' qt_s_fin  : ', qt_s_fin(ji,jl) 
    706 !        WRITE(numout,*) ' qt        : ', qt_i_fin(ji,jl) + & 
    707 !                                         qt_s_fin(ji,jl) 
    708          WRITE(numout,*) ' ht_i       : ', ht_i_b(ji) 
    709          WRITE(numout,*) ' ht_s       : ', ht_s_b(ji) 
    710          WRITE(numout,*) ' t_su       : ', t_su_b(ji) 
    711          WRITE(numout,*) ' t_s        : ', t_s_b(ji,1) 
    712          WRITE(numout,*) ' t_i        : ', t_i_b(ji,1:nlay_i) 
    713          WRITE(numout,*) ' t_bo       : ', t_bo_b(ji) 
    714          WRITE(numout,*) ' q_i        : ', q_i_b(ji,1:nlay_i) 
    715          WRITE(numout,*) ' s_i        : ', s_i_b(ji,1:nlay_i) 
    716          WRITE(numout,*) ' tmelts     : ', rtt - tmut*s_i_b(ji,1:nlay_i) 
    717          WRITE(numout,*) 
    718          WRITE(numout,*) ' Fluxes ' 
    719          WRITE(numout,*) ' ~~~~~~ ' 
    720          WRITE(numout,*) ' fatm       : ', fatm(ji,jl) 
    721          WRITE(numout,*) ' fc_su      : ', fc_su    (ji) 
    722          WRITE(numout,*) ' fstr_inice : ', qsr_ice_1d(ji)*i0(ji) 
    723          WRITE(numout,*) ' fc_bo      : ', - fc_bo_i  (ji) 
    724          WRITE(numout,*) ' foc        : ', fbif_1d(ji) 
    725          WRITE(numout,*) ' fstroc     : ', fstroc   (zji,zjj,jl) 
    726          WRITE(numout,*) ' i0         : ', i0(ji) 
    727          WRITE(numout,*) ' qsr_ice    : ', (1.0-i0(ji))*qsr_ice_1d(ji) 
    728          WRITE(numout,*) ' qns_ice    : ', qnsr_ice_1d(ji) 
    729          WRITE(numout,*) ' Conduction fluxes : ' 
    730          WRITE(numout,*) ' fc_s      : ', fc_s(ji,0:nlay_s) 
    731          WRITE(numout,*) ' fc_i      : ', fc_i(ji,0:nlay_i) 
    732          WRITE(numout,*) 
    733          WRITE(numout,*) ' Layer by layer ... ' 
    734          WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - & 
    735                                           qt_s_in(ji,jl) )  &  
    736                                                  / rdt_ice 
    737          WRITE(numout,*) ' dfc_snow  : ', fc_s(ji,1) -      & 
    738                                           fc_s(ji,0) 
    739          DO jk = 1, nlay_i 
    740             WRITE(numout,*) ' layer  : ', jk 
    741             WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) / rdt_ice   
    742             WRITE(numout,*) ' radab  : ', radab(ji,jk) 
    743             WRITE(numout,*) ' dfc_i  : ', fc_i(ji,jk) -               & 
    744                                           fc_i(ji,jk-1) 
    745             WRITE(numout,*) ' tot f  : ', fc_i(ji,jk) -               & 
    746                                           fc_i(ji,jk-1) - radab(ji,jk) 
    747          END DO 
     692            ( cons_error(ji,jl) .GT. max_cons_err  ) ) THEN 
     693            zji                 = MOD( npb(ji) - 1, jpi ) + 1 
     694            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
     695 
     696            WRITE(numout,*) ' alerte 1     ' 
     697            WRITE(numout,*) ' Untolerated conservation / surface error after ' 
     698            WRITE(numout,*) ' heat diffusion in the ice ' 
     699            WRITE(numout,*) ' Category   : ', jl 
     700            WRITE(numout,*) ' zji , zjj  : ', zji, zjj 
     701            WRITE(numout,*) ' lat, lon   : ', gphit(zji,zjj), glamt(zji,zjj) 
     702            WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
     703            WRITE(numout,*) ' surf_error : ', surf_error(ji,jl) 
     704            WRITE(numout,*) ' dq_i       : ', - dq_i(ji,jl) / rdt_ice 
     705            WRITE(numout,*) ' Fdt        : ', sum_fluxq(ji,jl) 
     706            WRITE(numout,*) 
     707            !        WRITE(numout,*) ' qt_i_in   : ', qt_i_in(ji,jl) 
     708            !        WRITE(numout,*) ' qt_s_in   : ', qt_s_in(ji,jl) 
     709            !        WRITE(numout,*) ' qt_i_fin  : ', qt_i_fin(ji,jl) 
     710            !        WRITE(numout,*) ' qt_s_fin  : ', qt_s_fin(ji,jl) 
     711            !        WRITE(numout,*) ' qt        : ', qt_i_fin(ji,jl) + & 
     712            !                                         qt_s_fin(ji,jl) 
     713            WRITE(numout,*) ' ht_i       : ', ht_i_b(ji) 
     714            WRITE(numout,*) ' ht_s       : ', ht_s_b(ji) 
     715            WRITE(numout,*) ' t_su       : ', t_su_b(ji) 
     716            WRITE(numout,*) ' t_s        : ', t_s_b(ji,1) 
     717            WRITE(numout,*) ' t_i        : ', t_i_b(ji,1:nlay_i) 
     718            WRITE(numout,*) ' t_bo       : ', t_bo_b(ji) 
     719            WRITE(numout,*) ' q_i        : ', q_i_b(ji,1:nlay_i) 
     720            WRITE(numout,*) ' s_i        : ', s_i_b(ji,1:nlay_i) 
     721            WRITE(numout,*) ' tmelts     : ', rtt - tmut*s_i_b(ji,1:nlay_i) 
     722            WRITE(numout,*) 
     723            WRITE(numout,*) ' Fluxes ' 
     724            WRITE(numout,*) ' ~~~~~~ ' 
     725            WRITE(numout,*) ' fatm       : ', fatm(ji,jl) 
     726            WRITE(numout,*) ' fc_su      : ', fc_su    (ji) 
     727            WRITE(numout,*) ' fstr_inice : ', qsr_ice_1d(ji)*i0(ji) 
     728            WRITE(numout,*) ' fc_bo      : ', - fc_bo_i  (ji) 
     729            WRITE(numout,*) ' foc        : ', fbif_1d(ji) 
     730            WRITE(numout,*) ' fstroc     : ', fstroc   (zji,zjj,jl) 
     731            WRITE(numout,*) ' i0         : ', i0(ji) 
     732            WRITE(numout,*) ' qsr_ice    : ', (1.0-i0(ji))*qsr_ice_1d(ji) 
     733            WRITE(numout,*) ' qns_ice    : ', qnsr_ice_1d(ji) 
     734            WRITE(numout,*) ' Conduction fluxes : ' 
     735            WRITE(numout,*) ' fc_s      : ', fc_s(ji,0:nlay_s) 
     736            WRITE(numout,*) ' fc_i      : ', fc_i(ji,0:nlay_i) 
     737            WRITE(numout,*) 
     738            WRITE(numout,*) ' Layer by layer ... ' 
     739            WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - & 
     740               qt_s_in(ji,jl) )  &  
     741               / rdt_ice 
     742            WRITE(numout,*) ' dfc_snow  : ', fc_s(ji,1) -      & 
     743               fc_s(ji,0) 
     744            DO jk = 1, nlay_i 
     745               WRITE(numout,*) ' layer  : ', jk 
     746               WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) / rdt_ice   
     747               WRITE(numout,*) ' radab  : ', radab(ji,jk) 
     748               WRITE(numout,*) ' dfc_i  : ', fc_i(ji,jk) -               & 
     749                  fc_i(ji,jk-1) 
     750               WRITE(numout,*) ' tot f  : ', fc_i(ji,jk) -               & 
     751                  fc_i(ji,jk-1) - radab(ji,jk) 
     752            END DO 
    748753 
    749754         ENDIF 
    750755 
    751756      END DO 
    752   
     757 
    753758   END SUBROUTINE lim_thd_con_dif 
    754759 
    755 !============================================================================== 
     760   !============================================================================== 
    756761 
    757762   SUBROUTINE lim_thd_con_dh(kideb,kiut,jl) 
    … …  
    775780      INTEGER ::                    & 
    776781         numce                         !: number of points for which conservation 
    777                                        !  is violated 
     782      !  is violated 
    778783      INTEGER  ::  ji, zji, zjj        ! loop indices 
    779784      !!--------------------------------------------------------------------- 
    780785 
    781786      max_cons_err = 1.0 
    782              
     787 
    783788      !-------------------------- 
    784789      ! Increment of energy 
    … …  
    786791      ! global 
    787792      DO ji = kideb, kiut 
    788           dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl)  & 
    789                       + qt_s_fin(ji,jl) - qt_s_in(ji,jl) 
     793         dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl)  & 
     794            + qt_s_fin(ji,jl) - qt_s_in(ji,jl) 
    790795      END DO 
    791796      ! layer by layer 
    … …  
    797802 
    798803      DO ji = kideb, kiut 
    799           zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    800           zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    801  
    802           fatm(ji,jl) = & 
    803           qnsr_ice_1d(ji)                  + & ! atm non solar 
    804 !         (1.0-i0(ji))*qsr_ice_1d(ji)          ! atm solar 
    805           qsr_ice_1d(ji)                       ! atm solar 
    806  
    807           sum_fluxq(ji,jl)     = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) &  
    808                                - fstroc(zji,zjj,jl)  
    809           cons_error(ji,jl)   = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) 
     804         zji                 = MOD( npb(ji) - 1, jpi ) + 1 
     805         zjj                 = ( npb(ji) - 1 ) / jpi + 1 
     806 
     807         fatm(ji,jl) = & 
     808            qnsr_ice_1d(ji)                  + & ! atm non solar 
     809            !         (1.0-i0(ji))*qsr_ice_1d(ji)          ! atm solar 
     810            qsr_ice_1d(ji)                       ! atm solar 
     811 
     812         sum_fluxq(ji,jl)     = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) &  
     813            - fstroc(zji,zjj,jl)  
     814         cons_error(ji,jl)   = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) 
    810815      END DO 
    811816 
    … …  
    815820 
    816821      DO ji = kideb, kiut 
    817           cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) 
     822         cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) 
    818823      END DO 
    819824 
    … …  
    821826      meance = 0.0 
    822827      DO ji = kideb, kiut 
    823           IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 
    824               numce = numce + 1 
    825               meance = meance + cons_error(ji,jl) 
    826           ENDIF 
     828         IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 
     829            numce = numce + 1 
     830            meance = meance + cons_error(ji,jl) 
     831         ENDIF 
    827832      ENDDO 
    828833      IF (numce .GT. 0 ) meance = meance / numce 
    … …  
    833838      WRITE(numout,*) ' After lim_thd_ent, category : ', jl 
    834839      WRITE(numout,*) ' Mean conservation error on big error points ', meance, & 
    835       numit 
     840         numit 
    836841      WRITE(numout,*) ' Number of points where there is a cons err gt than 0.1 W/m2 : ', numce, numit 
    837842 
    … …  
    842847      DO ji = kideb, kiut 
    843848         IF ( cons_error(ji,jl) .GT. max_cons_err  ) THEN 
    844          zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    845          zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    846  
    847          WRITE(numout,*) ' alerte 1 - category : ', jl 
    848          WRITE(numout,*) ' Untolerated conservation error after limthd_ent ' 
    849          WRITE(numout,*) ' zji , zjj  : ', zji, zjj 
    850          WRITE(numout,*) ' lat, lon   : ', gphit(zji,zjj), glamt(zji,zjj) 
    851          WRITE(numout,*) ' * ' 
    852          WRITE(numout,*) ' Ftotal     : ', sum_fluxq(ji,jl) 
    853          WRITE(numout,*) ' dq_t       : ', - dq_i(ji,jl) / rdt_ice 
    854          WRITE(numout,*) ' dq_i       : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) / rdt_ice 
    855          WRITE(numout,*) ' dq_s       : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) / rdt_ice 
    856          WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
    857          WRITE(numout,*) ' * ' 
    858          WRITE(numout,*) ' Fluxes        --- : ' 
    859          WRITE(numout,*) ' fatm       : ', fatm(ji,jl) 
    860          WRITE(numout,*) ' foce       : ', fbif_1d(ji) 
    861          WRITE(numout,*) ' fres       : ', ftotal_fin(ji) 
    862          WRITE(numout,*) ' fhbri      : ', fhbricat(zji,zjj,jl) 
    863          WRITE(numout,*) ' * ' 
    864          WRITE(numout,*) ' Heat contents --- : ' 
    865          WRITE(numout,*) ' qt_s_in    : ', qt_s_in(ji,jl) / rdt_ice 
    866          WRITE(numout,*) ' qt_i_in    : ', qt_i_in(ji,jl) / rdt_ice 
    867          WRITE(numout,*) ' qt_in      : ', ( qt_i_in(ji,jl) + & 
    868                                            qt_s_in(ji,jl) ) / rdt_ice 
    869          WRITE(numout,*) ' qt_s_fin   : ', qt_s_fin(ji,jl) / rdt_ice 
    870          WRITE(numout,*) ' qt_i_fin   : ', qt_i_fin(ji,jl) / rdt_ice 
    871          WRITE(numout,*) ' qt_fin     : ', ( qt_i_fin(ji,jl) + & 
    872                                            qt_s_fin(ji,jl) ) / rdt_ice 
    873          WRITE(numout,*) ' * ' 
    874          WRITE(numout,*) ' Ice variables --- : ' 
    875          WRITE(numout,*) ' ht_i       : ', ht_i_b(ji) 
    876          WRITE(numout,*) ' ht_s       : ', ht_s_b(ji) 
    877          WRITE(numout,*) ' dh_s_tot  : ', dh_s_tot(ji) 
    878          WRITE(numout,*) ' dh_snowice: ', dh_snowice(ji) 
    879          WRITE(numout,*) ' dh_i_surf : ', dh_i_surf(ji) 
    880          WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
     849            zji                 = MOD( npb(ji) - 1, jpi ) + 1 
     850            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
     851 
     852            WRITE(numout,*) ' alerte 1 - category : ', jl 
     853            WRITE(numout,*) ' Untolerated conservation error after limthd_ent ' 
     854            WRITE(numout,*) ' zji , zjj  : ', zji, zjj 
     855            WRITE(numout,*) ' lat, lon   : ', gphit(zji,zjj), glamt(zji,zjj) 
     856            WRITE(numout,*) ' * ' 
     857            WRITE(numout,*) ' Ftotal     : ', sum_fluxq(ji,jl) 
     858            WRITE(numout,*) ' dq_t       : ', - dq_i(ji,jl) / rdt_ice 
     859            WRITE(numout,*) ' dq_i       : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) / rdt_ice 
     860            WRITE(numout,*) ' dq_s       : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) / rdt_ice 
     861            WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
     862            WRITE(numout,*) ' * ' 
     863            WRITE(numout,*) ' Fluxes        --- : ' 
     864            WRITE(numout,*) ' fatm       : ', fatm(ji,jl) 
     865            WRITE(numout,*) ' foce       : ', fbif_1d(ji) 
     866            WRITE(numout,*) ' fres       : ', ftotal_fin(ji) 
     867            WRITE(numout,*) ' fhbri      : ', fhbricat(zji,zjj,jl) 
     868            WRITE(numout,*) ' * ' 
     869            WRITE(numout,*) ' Heat contents --- : ' 
     870            WRITE(numout,*) ' qt_s_in    : ', qt_s_in(ji,jl) / rdt_ice 
     871            WRITE(numout,*) ' qt_i_in    : ', qt_i_in(ji,jl) / rdt_ice 
     872            WRITE(numout,*) ' qt_in      : ', ( qt_i_in(ji,jl) + & 
     873               qt_s_in(ji,jl) ) / rdt_ice 
     874            WRITE(numout,*) ' qt_s_fin   : ', qt_s_fin(ji,jl) / rdt_ice 
     875            WRITE(numout,*) ' qt_i_fin   : ', qt_i_fin(ji,jl) / rdt_ice 
     876            WRITE(numout,*) ' qt_fin     : ', ( qt_i_fin(ji,jl) + & 
     877               qt_s_fin(ji,jl) ) / rdt_ice 
     878            WRITE(numout,*) ' * ' 
     879            WRITE(numout,*) ' Ice variables --- : ' 
     880            WRITE(numout,*) ' ht_i       : ', ht_i_b(ji) 
     881            WRITE(numout,*) ' ht_s       : ', ht_s_b(ji) 
     882            WRITE(numout,*) ' dh_s_tot  : ', dh_s_tot(ji) 
     883            WRITE(numout,*) ' dh_snowice: ', dh_snowice(ji) 
     884            WRITE(numout,*) ' dh_i_surf : ', dh_i_surf(ji) 
     885            WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
    881886 
    882887         ENDIF 
    883888 
    884889      END DO 
    885   
     890 
    886891   END SUBROUTINE lim_thd_con_dh 
    887 !============================================================================== 
     892   !============================================================================== 
    888893 
    889894   SUBROUTINE lim_thd_enmelt(kideb,kiut) 
    … …  
    899904      INTEGER, INTENT(in) ::        & 
    900905         kideb, kiut                   !: bounds for the spatial loop 
    901           
     906 
    902907      REAL(wp)                 ::   &  !: goes to trash 
    903908         ztmelts               ,    &  !: sea ice freezing point in K 
    … …  
    916921            ztmelts      =   - tmut * s_i_b(ji,jk) + rtt  
    917922            q_i_b(ji,jk) =   rhoic*( cpic    * ( ztmelts - t_i_b(ji,jk) )  & 
    918                          + lfus  * ( 1.0 - (ztmelts-rtt)/MIN((t_i_b(ji,jk)-rtt),-zeps) )  & 
    919                          - rcp      * ( ztmelts-rtt  ) )  
     923               + lfus  * ( 1.0 - (ztmelts-rtt)/MIN((t_i_b(ji,jk)-rtt),-zeps) )  & 
     924               - rcp      * ( ztmelts-rtt  ) )  
    920925         END DO !ji 
    921926      END DO !jk 
    … …  
    930935   END SUBROUTINE lim_thd_enmelt 
    931936 
    932 !============================================================================== 
     937   !============================================================================== 
    933938 
    934939   SUBROUTINE lim_thd_init 
    … …  
    954959         &                kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi 
    955960      !!------------------------------------------------------------------- 
    956        
     961 
    957962      ! Define the initial parameters 
    958963      ! ------------------------- 
    … …  
    990995         WRITE(numout,*) 
    991996      ENDIF 
    992              
     997 
    993998      rcdsn = hakdif * rcdsn  
    994999      rcdic = hakdif * rcdic 
    995        
     1000 
    9961001 
    9971002   END SUBROUTINE lim_thd_init 

  • trunk/NEMO/LIM_SRC_3/limthd_dh.F90

    r888 r921  
    2424   USE par_ice 
    2525   USE lib_mpp 
    26        
     26 
    2727   IMPLICIT NONE 
    2828   PRIVATE 
    … …  
    4646 
    4747   SUBROUTINE lim_thd_dh(kideb,kiut,jl) 
    48        !!------------------------------------------------------------------ 
    49        !!                ***  ROUTINE lim_thd_dh  *** 
    50        !!------------------------------------------------------------------ 
    51        !! ** Purpose : 
    52        !!           This routine determines variations of ice and snow thicknesses. 
    53        !! ** Method  : 
    54        !!           Ice/Snow surface melting arises from imbalance in surface fluxes 
    55        !!           Bottom accretion/ablation arises from flux budget 
    56        !!           Snow thickness can increase by precipitation and decrease by  
    57        !!              sublimation 
    58        !!           If snow load excesses Archmiede limit, snow-ice is formed by 
    59        !!              the flooding of sea-water in the snow 
    60        !! ** Steps   
    61        !!           1) Compute available flux of heat for surface ablation 
    62        !!           2) Compute snow and sea ice enthalpies 
    63        !!           3) Surface ablation and sublimation 
    64        !!           4) Bottom accretion/ablation 
    65        !!           5) Case of Total ablation 
    66        !!           6) Snow ice formation 
    67        !! 
    68        !! ** Arguments 
    69        !! 
    70        !! ** Inputs / Outputs 
    71        !! 
    72        !! ** External 
    73        !! 
    74        !! ** References : Bitz and Lipscomb, JGR 99 
    75        !!                 Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646    
    76        !!                 Vancoppenolle, Fichefet and Bitz, GRL 2005 
    77        !!                 Vancoppenolle et al., OM08 
    78        !! 
    79        !! ** History  :  
    80        !!   original code    01-04 (LIM) 
    81        !!   original routine 
    82        !!               (05-2003) M. Vancoppenolle, Louvain-La-Neuve, Belgium 
    83        !!               (06/07-2005) 3D version 
    84        !!               (03-2008)    Clean code 
    85        !! 
    86        !!------------------------------------------------------------------ 
    87        !! * Arguments 
    88        INTEGER , INTENT (IN) ::  & 
    89           kideb     ,         &  !: Start point on which the  the computation is applied 
    90           kiut      ,         &  !: End point on which the  the computation is applied 
    91           jl                     !: Thickness cateogry number 
    92  
    93        !! * Local variables 
    94        INTEGER ::             &  
    95           ji        ,         &  !: space index  
    96           jk        ,         &  !: ice layer index 
    97           isnow     ,         &  !: switch for presence (1) or absence (0) of snow 
    98           zji       ,         &  !: 2D corresponding indices to ji 
    99           zjj       ,         & 
    100           isnowic   ,         &  !: snow ice formation not 
    101           i_ice_switch   ,    &  !: ice thickness above a certain treshold or not 
    102           iter 
    103  
    104        REAL(wp) ::            & 
    105           zhsnew    ,         &  !: new snow thickness 
    106           zihgnew   ,         &  !: switch for total ablation 
    107           ztmelts   ,         &  !: melting point 
    108           zhn       ,         & 
    109           zdhcf     ,         & 
    110           zdhbf     ,         & 
    111           zhni      ,         & 
    112           zhnfi     ,         & 
    113           zihg      ,         & 
    114           zdhnm     ,         & 
    115           zhnnew    ,         & 
    116           zeps = 1.0e-13,     & 
    117           zhisn     ,         & 
    118           zfracs    ,         &  !: fractionation coefficient for bottom salt 
    119                                  !: entrapment 
    120           zds       ,         &  !: increment of bottom ice salinity 
    121           zcoeff    ,         &  !: dummy argument for snowfall partitioning 
    122                                  !: over ice and leads 
    123           zsm_snowice,        &  !: snow-ice salinity 
    124           zswi1     ,         &  !: switch for computation of bottom salinity 
    125           zswi12    ,         &  !: switch for computation of bottom salinity 
    126           zswi2     ,         &  !: switch for computation of bottom salinity 
    127           zgrr      ,         &  !: bottom growth rate 
    128           zihic     ,         &  !:  
    129           ztform                 !: bottom formation temperature 
    130  
    131        REAL(wp) , DIMENSION(jpij) ::  & 
    132           zh_i      ,         &  ! ice layer thickness 
    133           zh_s      ,         &  ! snow layer thickness 
    134           ztfs      ,         &  ! melting point 
    135           zhsold    ,         &  ! old snow thickness 
    136           zqprec    ,         &  !: energy of fallen snow 
    137           zqfont_su ,         &  ! incoming, remaining surface energy 
    138           zqfont_bo              ! incoming, bottom energy 
    139  
    140        REAL(wp) , DIMENSION(jpij) :: & 
    141           z_f_surf,           &  ! surface heat for ablation 
    142           zhgnew                 ! new ice thickness 
    143  
    144        REAL(wp), DIMENSION(jpij) :: & 
    145           zdh_s_mel  ,        &  ! snow melt  
    146           zdh_s_pre  ,        &  ! snow precipitation  
    147           zdh_s_sub  ,        &  ! snow sublimation 
    148           zfsalt_melt            ! salt flux due to ice melt 
    149  
    150        REAL(wp) , DIMENSION(jpij,jkmax) :: & 
    151           zdeltah 
    152  
    153        ! Pathological cases 
    154        REAL(wp), DIMENSION(jpij) :: & 
    155           zfdt_init  ,        &  !: total incoming heat for ice melt 
    156           zfdt_final ,        &  !: total remaing heat for ice melt 
    157           zqt_i      ,        &  !: total ice heat content 
    158           zqt_s      ,        &  !: total snow heat content 
    159           zqt_dummy              !: dummy heat content 
    160  
    161        REAL(wp), DIMENSION(jpij,jkmax) :: & 
    162           zqt_i_lay              !: total ice heat content 
    163  
    164        ! Heat conservation  
    165        REAL(wp), DIMENSION(jpij) :: & 
    166           zfbase,             & 
    167           zdq_i 
    168  
    169        INTEGER, DIMENSION(jpij) ::  & 
    170           innermelt 
    171  
    172        REAL(wp) :: & 
    173           meance_dh 
    174  
    175        INTEGER ::                   & 
    176           num_iter_max,       & 
    177           numce_dh 
    178  
    179 !!----------------------------------------------------------------------------- 
    180  
    181       WRITE(numout,*) 'lim_thd_dh : computation of vertical snow/ice accretion/ablation' 
    182       WRITE(numout,*) '~~~~~~~~~' 
     48      !!------------------------------------------------------------------ 
     49      !!                ***  ROUTINE lim_thd_dh  *** 
     50      !!------------------------------------------------------------------ 
     51      !! ** Purpose : 
     52      !!           This routine determines variations of ice and snow thicknesses. 
     53      !! ** Method  : 
     54      !!           Ice/Snow surface melting arises from imbalance in surface fluxes 
     55      !!           Bottom accretion/ablation arises from flux budget 
     56      !!           Snow thickness can increase by precipitation and decrease by  
     57      !!              sublimation 
     58      !!           If snow load excesses Archmiede limit, snow-ice is formed by 
     59      !!              the flooding of sea-water in the snow 
     60      !! ** Steps   
     61      !!           1) Compute available flux of heat for surface ablation 
     62      !!           2) Compute snow and sea ice enthalpies 
     63      !!           3) Surface ablation and sublimation 
     64      !!           4) Bottom accretion/ablation 
     65      !!           5) Case of Total ablation 
     66      !!           6) Snow ice formation 
     67      !! 
     68      !! ** Arguments 
     69      !! 
     70      !! ** Inputs / Outputs 
     71      !! 
     72      !! ** External 
     73      !! 
     74      !! ** References : Bitz and Lipscomb, JGR 99 
     75      !!                 Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646    
     76      !!                 Vancoppenolle, Fichefet and Bitz, GRL 2005 
     77      !!                 Vancoppenolle et al., OM08 
     78      !! 
     79      !! ** History  :  
     80      !!   original code    01-04 (LIM) 
     81      !!   original routine 
     82      !!               (05-2003) M. Vancoppenolle, Louvain-La-Neuve, Belgium 
     83      !!               (06/07-2005) 3D version 
     84      !!               (03-2008)    Clean code 
     85      !! 
     86      !!------------------------------------------------------------------ 
     87      !! * Arguments 
     88      INTEGER , INTENT (IN) ::  & 
     89         kideb     ,         &  !: Start point on which the  the computation is applied 
     90         kiut      ,         &  !: End point on which the  the computation is applied 
     91         jl                     !: Thickness cateogry number 
     92 
     93      !! * Local variables 
     94      INTEGER ::             &  
     95         ji        ,         &  !: space index  
     96         jk        ,         &  !: ice layer index 
     97         isnow     ,         &  !: switch for presence (1) or absence (0) of snow 
     98         zji       ,         &  !: 2D corresponding indices to ji 
     99         zjj       ,         & 
     100         isnowic   ,         &  !: snow ice formation not 
     101         i_ice_switch   ,    &  !: ice thickness above a certain treshold or not 
     102         iter 
     103 
     104      REAL(wp) ::            & 
     105         zhsnew    ,         &  !: new snow thickness 
     106         zihgnew   ,         &  !: switch for total ablation 
     107         ztmelts   ,         &  !: melting point 
     108         zhn       ,         & 
     109         zdhcf     ,         & 
     110         zdhbf     ,         & 
     111         zhni      ,         & 
     112         zhnfi     ,         & 
     113         zihg      ,         & 
     114         zdhnm     ,         & 
     115         zhnnew    ,         & 
     116         zeps = 1.0e-13,     & 
     117         zhisn     ,         & 
     118         zfracs    ,         &  !: fractionation coefficient for bottom salt 
     119                                !: entrapment 
     120         zds       ,         &  !: increment of bottom ice salinity 
     121         zcoeff    ,         &  !: dummy argument for snowfall partitioning 
     122                                !: over ice and leads 
     123         zsm_snowice,        &  !: snow-ice salinity 
     124         zswi1     ,         &  !: switch for computation of bottom salinity 
     125         zswi12    ,         &  !: switch for computation of bottom salinity 
     126         zswi2     ,         &  !: switch for computation of bottom salinity 
     127         zgrr      ,         &  !: bottom growth rate 
     128         zihic     ,         &  !:  
     129         ztform                 !: bottom formation temperature 
     130 
     131      REAL(wp) , DIMENSION(jpij) ::  & 
     132         zh_i      ,         &  ! ice layer thickness 
     133         zh_s      ,         &  ! snow layer thickness 
     134         ztfs      ,         &  ! melting point 
     135         zhsold    ,         &  ! old snow thickness 
     136         zqprec    ,         &  !: energy of fallen snow 
     137         zqfont_su ,         &  ! incoming, remaining surface energy 
     138         zqfont_bo              ! incoming, bottom energy 
     139 
     140      REAL(wp) , DIMENSION(jpij) :: & 
     141         z_f_surf,           &  ! surface heat for ablation 
     142         zhgnew                 ! new ice thickness 
     143 
     144      REAL(wp), DIMENSION(jpij) :: & 
     145         zdh_s_mel  ,        &  ! snow melt  
     146         zdh_s_pre  ,        &  ! snow precipitation  
     147         zdh_s_sub  ,        &  ! snow sublimation 
     148         zfsalt_melt            ! salt flux due to ice melt 
     149 
     150      REAL(wp) , DIMENSION(jpij,jkmax) :: & 
     151         zdeltah 
     152 
     153      ! Pathological cases 
     154      REAL(wp), DIMENSION(jpij) :: & 
     155         zfdt_init  ,        &  !: total incoming heat for ice melt 
     156         zfdt_final ,        &  !: total remaing heat for ice melt 
     157         zqt_i      ,        &  !: total ice heat content 
     158         zqt_s      ,        &  !: total snow heat content 
     159         zqt_dummy              !: dummy heat content 
     160 
     161      REAL(wp), DIMENSION(jpij,jkmax) :: & 
     162         zqt_i_lay              !: total ice heat content 
     163 
     164      ! Heat conservation  
     165      REAL(wp), DIMENSION(jpij) :: & 
     166         zfbase,             & 
     167         zdq_i 
     168 
     169      INTEGER, DIMENSION(jpij) ::  & 
     170         innermelt 
     171 
     172      REAL(wp) :: & 
     173         meance_dh 
     174 
     175      INTEGER ::                   & 
     176         num_iter_max,       & 
     177         numce_dh 
    183178 
    184179      zfsalt_melt(:)  = 0.0 
    … …  
    191186         old_ht_s_b(ji) = ht_s_b(ji) 
    192187      END DO 
    193 ! 
    194 !------------------------------------------------------------------------------! 
    195 !  1) Calculate available heat for surface ablation                            ! 
    196 !------------------------------------------------------------------------------! 
    197 ! 
     188      ! 
     189      !------------------------------------------------------------------------------! 
     190      !  1) Calculate available heat for surface ablation                            ! 
     191      !------------------------------------------------------------------------------! 
     192      ! 
    198193      DO ji = kideb,kiut 
    199194         isnow         = INT( 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s_b(ji) ) ) ) 
    200195         ztfs(ji)      = isnow * rtt + ( 1.0 - isnow ) * rtt 
    201196         z_f_surf(ji)  = qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) *                 &  
    202                          qsr_ice_1d(ji) - fc_su(ji) 
     197            qsr_ice_1d(ji) - fc_su(ji) 
    203198         z_f_surf(ji)  = MAX( zzero , z_f_surf(ji) ) *                        & 
    204                          MAX( zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) ) ) 
     199            MAX( zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) ) ) 
    205200         zfdt_init(ji) = ( z_f_surf(ji) + & 
    206                        MAX( fbif_1d(ji) + qlbbq_1d(ji) + fc_bo_i(ji),0.0 ) )  & 
    207                        * rdt_ice 
     201            MAX( fbif_1d(ji) + qlbbq_1d(ji) + fc_bo_i(ji),0.0 ) )  & 
     202            * rdt_ice 
    208203      END DO ! ji 
    209204 
    … …  
    212207      dsm_i_se_1d(:) = 0.0      
    213208      dsm_i_si_1d(:) = 0.0      
    214 ! 
    215 !------------------------------------------------------------------------------! 
    216 !  2) Computing layer thicknesses and  snow and sea-ice enthalpies.            ! 
    217 !------------------------------------------------------------------------------! 
    218 ! 
     209      ! 
     210      !------------------------------------------------------------------------------! 
     211      !  2) Computing layer thicknesses and  snow and sea-ice enthalpies.            ! 
     212      !------------------------------------------------------------------------------! 
     213      ! 
    219214      ! Layer thickness 
    220215      DO ji = kideb,kiut 
    … …  
    239234         END DO 
    240235      END DO 
    241 ! 
    242 !------------------------------------------------------------------------------| 
    243 !  3) Surface ablation and sublimation                                         | 
    244 !------------------------------------------------------------------------------| 
    245 ! 
     236      ! 
     237      !------------------------------------------------------------------------------| 
     238      !  3) Surface ablation and sublimation                                         | 
     239      !------------------------------------------------------------------------------| 
     240      ! 
    246241      !------------------------- 
    247242      ! 3.1 Snow precips / melt 
    … …  
    272267         zdeltah(ji,1)  =  MIN( 0.0 , - zqfont_su(ji) / MAX( zqprec(ji) , epsi13 ) ) 
    273268         zqfont_su(ji)  =  MAX( 0.0 , - zdh_s_pre(ji) - zdeltah(ji,1) )      * & 
    274                            zqprec(ji) 
     269            zqprec(ji) 
    275270         zdeltah(ji,1)  =  MAX( - zdh_s_pre(ji) , zdeltah(ji,1) ) 
    276271         zdh_s_mel(ji)  =  zdh_s_mel(ji) + zdeltah(ji,1) 
    … …  
    289284            zdeltah(ji,jk) = - zqfont_su(ji) / q_s_b(ji,jk) 
    290285            zqfont_su(ji)  =  MAX( 0.0 , - zh_s(ji) - zdeltah(ji,jk) ) * & 
    291                               q_s_b(ji,jk)  
     286               q_s_b(ji,jk)  
    292287            zdeltah(ji,jk) =  MAX( zdeltah(ji,jk) , - zh_s(ji) ) 
    293288            zdh_s_mel(ji)  =  zdh_s_mel(ji) + zdeltah(ji,jk) !resulting melt of snow     
    … …  
    306301         ! Volume and mass variations of snow 
    307302         dvsbq_1d(ji)   =  a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji)              & 
    308                         - zdh_s_mel(ji) ) 
     303            - zdh_s_mel(ji) ) 
    309304         dvsbq_1d(ji)   =  MIN( zzero, dvsbq_1d(ji) ) 
    310305         rdmsnif_1d(ji) =  rhosn*dvsbq_1d(ji) 
    … …  
    327322            ! recompute heat available 
    328323            zqfont_su(ji)       = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) *  & 
    329                                   q_i_b(ji,jk)  
     324               q_i_b(ji,jk)  
    330325            ! melt of layer jk cannot be higher than its thickness 
    331326            zdeltah(ji,jk)      = MAX( zdeltah(ji,jk) , - zh_i(ji) ) 
    … …  
    334329            ! for energy conservation 
    335330            zdq_i(ji)           = zdq_i(ji) + zdeltah(ji,jk) *                & 
    336                                         q_i_b(ji,jk) / rdt_ice 
     331               q_i_b(ji,jk) / rdt_ice 
    337332            ! contribution to ice-ocean salt flux  
    338333            zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    339334            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    340335            zfsalt_melt(ji)     = zfsalt_melt(ji) +                           & 
    341                                   ( sss_m(zji,zjj) - sm_i_b(ji)   ) *         & 
    342                                   a_i_b(ji) *                                 & 
    343                                   MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice  
     336               ( sss_m(zji,zjj) - sm_i_b(ji)   ) *         & 
     337               a_i_b(ji) *                                 & 
     338               MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice  
    344339         END DO ! ji 
    345340      END DO ! jk 
    … …  
    349344      !------------------- 
    350345      IF ( con_i ) THEN 
    351       numce_dh = 0 
    352       meance_dh = 0.0 
    353       DO ji = kideb, kiut 
    354  
    355          IF ( ( z_f_surf(ji) + zdq_i(ji) ) .GE. 1.0e-3 ) THEN 
    356             numce_dh  = numce_dh + 1 
    357             meance_dh = meance_dh + z_f_surf(ji) + zdq_i(ji) 
    358          ENDIF 
    359  
    360          IF ( z_f_surf(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN! 
    361             WRITE(numout,*) ' ALERTE heat loss for surface melt ' 
    362             WRITE(numout,*) ' zji, zjj, jl :', zji, zjj, jl 
    363             WRITE(numout,*) ' ht_i_b  : ', ht_i_b(ji) 
    364             WRITE(numout,*) ' z_f_surf  : ', z_f_surf(ji) 
    365             WRITE(numout,*) ' zdq_i   : ', zdq_i(ji) 
    366             WRITE(numout,*) ' ht_i_b  : ', ht_i_b(ji) 
    367             WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji) 
    368             WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji) 
    369             WRITE(numout,*) ' qlbbq_1d: ', qlbbq_1d(ji) 
    370             WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 
    371             WRITE(numout,*) ' sss_m   : ', sss_m(zji,zjj) 
    372          ENDIF 
    373  
    374       END DO ! ji 
    375  
    376       IF ( numce_dh .GT. 0 ) meance_dh = meance_dh / numce_dh 
    377       WRITE(numout,*) ' Error report - Category : ', jl 
    378       WRITE(numout,*) ' ~~~~~~~~~~~~ ' 
    379       WRITE(numout,*) ' Number of points where there is sur. me. error : ', numce_dh 
    380       WRITE(numout,*) ' Mean basal growth error on error points : ', meance_dh 
     346         numce_dh = 0 
     347         meance_dh = 0.0 
     348         DO ji = kideb, kiut 
     349 
     350            IF ( ( z_f_surf(ji) + zdq_i(ji) ) .GE. 1.0e-3 ) THEN 
     351               numce_dh  = numce_dh + 1 
     352               meance_dh = meance_dh + z_f_surf(ji) + zdq_i(ji) 
     353            ENDIF 
     354 
     355            IF ( z_f_surf(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN! 
     356               WRITE(numout,*) ' ALERTE heat loss for surface melt ' 
     357               WRITE(numout,*) ' zji, zjj, jl :', zji, zjj, jl 
     358               WRITE(numout,*) ' ht_i_b  : ', ht_i_b(ji) 
     359               WRITE(numout,*) ' z_f_surf  : ', z_f_surf(ji) 
     360               WRITE(numout,*) ' zdq_i   : ', zdq_i(ji) 
     361               WRITE(numout,*) ' ht_i_b  : ', ht_i_b(ji) 
     362               WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji) 
     363               WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji) 
     364               WRITE(numout,*) ' qlbbq_1d: ', qlbbq_1d(ji) 
     365               WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 
     366               WRITE(numout,*) ' sss_m   : ', sss_m(zji,zjj) 
     367            ENDIF 
     368 
     369         END DO ! ji 
     370 
     371         IF ( numce_dh .GT. 0 ) meance_dh = meance_dh / numce_dh 
     372         WRITE(numout,*) ' Error report - Category : ', jl 
     373         WRITE(numout,*) ' ~~~~~~~~~~~~ ' 
     374         WRITE(numout,*) ' Number of points where there is sur. me. error : ', numce_dh 
     375         WRITE(numout,*) ' Mean basal growth error on error points : ', meance_dh 
    381376 
    382377      ENDIF ! con_i 
    … …  
    409404      DO jk = 1, nlay_s !n  
    410405         DO ji = kideb, kiut !n 
    411          ! In case of disparition of the snow, we have to update the snow  
    412          ! temperatures 
     406            ! In case of disparition of the snow, we have to update the snow  
     407            ! temperatures 
    413408            zhisn  =  MAX( zzero , SIGN( zone, - ht_s_b(ji) ) ) 
    414409            t_s_b(ji,jk) = ( 1.0 - zhisn ) * t_s_b(ji,jk) + zhisn * rtt 
    415410            q_s_b(ji,jk) = ( 1.0 - zhisn ) * q_s_b(ji,jk) 
    416411         END DO 
    417       END DO  
    418  
    419 ! 
    420 !------------------------------------------------------------------------------! 
    421 ! 4) Basal growth / melt                                                       ! 
    422 !------------------------------------------------------------------------------! 
    423 ! 
     412      END DO 
     413 
     414      ! 
     415      !------------------------------------------------------------------------------! 
     416      ! 4) Basal growth / melt                                                       ! 
     417      !------------------------------------------------------------------------------! 
     418      ! 
    424419      ! Ice basal growth / melt is given by the ratio of heat budget over basal 
    425420      ! ice heat content.  Basal heat budget is given by the difference between 
    … …  
    439434               ! New ice heat content (Bitz and Lipscomb, 1999) 
    440435               ztform              =  t_i_b(ji,nlay_i)  ! t_bo_b crashes in the 
    441                                                         ! Baltic 
     436               ! Baltic 
    442437               q_i_b(ji,nlay_i+1)  =  rhoic * & 
    443                                       ( cpic * ( ztmelts - ztform     )       & 
    444                                       + lfus * ( 1.0 - ( ztmelts - rtt ) /    & 
    445                                                  ( ztform     - rtt ) )       & 
    446                                       - rcp * ( ztmelts-rtt ) ) 
     438                  ( cpic * ( ztmelts - ztform     )       & 
     439                  + lfus * ( 1.0 - ( ztmelts - rtt ) /    & 
     440                  ( ztform     - rtt ) )       & 
     441                  - rcp * ( ztmelts-rtt ) ) 
    447442               ! Basal growth rate = - F*dt / q 
    448443               dh_i_bott(ji)       =  - rdt_ice*( fc_bo_i(ji) + fbif_1d(ji) + & 
    449                                       qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)  
     444                  qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)  
    450445            ENDIF ! heat budget 
    451446         END DO ! ji 
    … …  
    476471                  ! New ice heat content (Bitz and Lipscomb, 1999) 
    477472                  q_i_b(ji,nlay_i+1)  =  rhoic * & 
    478                                       ( cpic * ( ztmelts - t_bo_b(ji) )       & 
    479                                       + lfus * ( 1.0 - ( ztmelts - rtt ) /    & 
    480                                                  ( t_bo_b(ji) - rtt ) )       & 
    481                                       - rcp * ( ztmelts-rtt ) ) 
     473                     ( cpic * ( ztmelts - t_bo_b(ji) )       & 
     474                     + lfus * ( 1.0 - ( ztmelts - rtt ) /    & 
     475                     ( t_bo_b(ji) - rtt ) )       & 
     476                     - rcp * ( ztmelts-rtt ) ) 
    482477                  ! Bottom growth rate = - F*dt / q 
    483478                  dh_i_bott(ji)       =  - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) & 
    484                                       + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 
     479                     + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 
    485480                  ! New ice salinity ( Cox and Weeks, JGR, 1988 ) 
    486481                  ! zswi2  (1) if dh_i_bott/rdt .GT. 3.6e-7 
    … …  
    492487                  zswi1  = 1. - zswi2 * zswi12  
    493488                  zfracs = zswi1  * 0.12 +  & 
    494                            zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) ) + & 
    495                            zswi2  * 0.26 /  & 
    496                            ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  
     489                     zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) ) + & 
     490                     zswi2  * 0.26 /  & 
     491                     ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  
    497492                  zds         = zfracs*sss_m(zji,zjj) - s_i_new(ji) 
    498493                  s_i_new(ji) = zfracs * sss_m(zji,zjj) 
    … …  
    510505               ! New ice heat content (Bitz and Lipscomb, 1999) 
    511506               q_i_b(ji,nlay_i+1)  =  rhoic *                              & 
    512                                    ( cpic * ( ztmelts - t_bo_b(ji) )       & 
    513                                    + lfus * ( 1.0 - ( ztmelts - rtt ) /    & 
    514                                               ( t_bo_b(ji) - rtt ) )       & 
    515                                    - rcp * ( ztmelts-rtt ) ) 
     507                  ( cpic * ( ztmelts - t_bo_b(ji) )       & 
     508                  + lfus * ( 1.0 - ( ztmelts - rtt ) /    & 
     509                  ( t_bo_b(ji) - rtt ) )       & 
     510                  - rcp * ( ztmelts-rtt ) ) 
    516511               ! Basal growth rate = - F*dt / q 
    517512               dh_i_bott(ji)       =  - rdt_ice*( fc_bo_i(ji) + fbif_1d(ji) + & 
    518                                       qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)  
     513                  qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)  
    519514               ! Salinity update 
    520515               ! entrapment during bottom growth 
    521516               dsm_i_se_1d(ji) =  ( s_i_new(ji)*dh_i_bott(ji) +              &  
    522                                    sm_i_b(ji)*ht_i_b(ji) ) /                 &  
    523                                    MAX( ht_i_b(ji) + dh_i_bott(ji) ,zeps )   & 
    524                                    - sm_i_b(ji) 
     517                  sm_i_b(ji)*ht_i_b(ji) ) /                 &  
     518                  MAX( ht_i_b(ji) + dh_i_bott(ji) ,zeps )   & 
     519                  - sm_i_b(ji) 
    525520            ENDIF ! heat budget 
    526521         END DO ! ji 
    … …  
    537532         ! heat convergence at the surface > 0 
    538533         IF (  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .GE. 0.0  ) THEN 
    539                   
     534 
    540535            s_i_new(ji)   =  s_i_b(ji,nlay_i) 
    541536            zqfont_bo(ji) =  rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) 
    … …  
    559554                  zdeltah(ji,jk)  = - zqfont_bo(ji) / q_i_b(ji,jk) 
    560555                  zqfont_bo(ji)   = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * & 
    561                                     q_i_b(ji,jk) 
     556                     q_i_b(ji,jk) 
    562557                  zdeltah(ji,jk)  = MAX(zdeltah(ji,jk), - zh_i(ji) ) 
    563558                  dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk) 
    564559                  zdq_i(ji)       = zdq_i(ji) + zdeltah(ji,jk) * & 
    565                                     q_i_b(ji,jk) / rdt_ice 
    566                ! contribution to salt flux 
     560                     q_i_b(ji,jk) / rdt_ice 
     561                  ! contribution to salt flux 
    567562                  zji             = MOD( npb(ji) - 1, jpi ) + 1 
    568563                  zjj             = ( npb(ji) - 1 ) / jpi + 1 
    569564                  zfsalt_melt(ji) = zfsalt_melt(ji) +                         & 
    570                                    ( sss_m(zji,zjj) - sm_i_b(ji)   ) *        & 
    571                                    a_i_b(ji) * & 
    572                                    MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice  
     565                     ( sss_m(zji,zjj) - sm_i_b(ji)   ) *        & 
     566                     a_i_b(ji) * & 
     567                     MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice  
    573568               ENDIF 
    574569            ENDIF 
    … …  
    580575      !------------------- 
    581576      IF ( con_i ) THEN 
    582       DO ji = kideb, kiut 
    583          IF (  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .GE. 0.0  ) THEN 
    584             IF ( ( zfbase(ji) + zdq_i(ji) ) .GE. 1.0e-3 ) THEN 
    585                numce_dh = numce_dh + 1 
    586                meance_dh = meance_dh + zfbase(ji) + zdq_i(ji) 
    587             ENDIF 
    588             IF ( zfbase(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN 
    589                 WRITE(numout,*) ' ALERTE heat loss for basal  melt ' 
    590                 WRITE(numout,*) ' zji, zjj, jl :', zji, zjj, jl 
    591                 WRITE(numout,*) ' ht_i_b  : ', ht_i_b(ji) 
    592                 WRITE(numout,*) ' zfbase  : ', zfbase(ji) 
    593                 WRITE(numout,*) ' zdq_i   : ', zdq_i(ji) 
    594                 WRITE(numout,*) ' ht_i_b  : ', ht_i_b(ji) 
    595                 WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji) 
    596                 WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji) 
    597                 WRITE(numout,*) ' qlbbq_1d: ', qlbbq_1d(ji) 
    598                 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 
    599                 WRITE(numout,*) ' sss_m   : ', sss_m(zji,zjj) 
    600                 WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
    601                 WRITE(numout,*) ' innermelt : ', innermelt(ji) 
    602             ENDIF 
    603          ENDIF ! heat convergence at the surface 
    604       END DO ! ji 
    605  
    606       IF ( numce_dh .GT. 0 ) meance_dh = meance_dh / numce_dh 
    607       WRITE(numout,*) ' Number of points where there is bas. me. error : ', numce_dh 
    608       WRITE(numout,*) ' Mean basal melt error on error points : ', meance_dh 
    609       WRITE(numout,*) ' Remaining bottom heat : ', zqfont_bo(jiindex_1d) 
     577         DO ji = kideb, kiut 
     578            IF (  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .GE. 0.0  ) THEN 
     579               IF ( ( zfbase(ji) + zdq_i(ji) ) .GE. 1.0e-3 ) THEN 
     580                  numce_dh = numce_dh + 1 
     581                  meance_dh = meance_dh + zfbase(ji) + zdq_i(ji) 
     582               ENDIF 
     583               IF ( zfbase(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN 
     584                  WRITE(numout,*) ' ALERTE heat loss for basal  melt ' 
     585                  WRITE(numout,*) ' zji, zjj, jl :', zji, zjj, jl 
     586                  WRITE(numout,*) ' ht_i_b  : ', ht_i_b(ji) 
     587                  WRITE(numout,*) ' zfbase  : ', zfbase(ji) 
     588                  WRITE(numout,*) ' zdq_i   : ', zdq_i(ji) 
     589                  WRITE(numout,*) ' ht_i_b  : ', ht_i_b(ji) 
     590                  WRITE(numout,*) ' fc_bo_i : ', fc_bo_i(ji) 
     591                  WRITE(numout,*) ' fbif_1d : ', fbif_1d(ji) 
     592                  WRITE(numout,*) ' qlbbq_1d: ', qlbbq_1d(ji) 
     593                  WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 
     594                  WRITE(numout,*) ' sss_m   : ', sss_m(zji,zjj) 
     595                  WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
     596                  WRITE(numout,*) ' innermelt : ', innermelt(ji) 
     597               ENDIF 
     598            ENDIF ! heat convergence at the surface 
     599         END DO ! ji 
     600 
     601         IF ( numce_dh .GT. 0 ) meance_dh = meance_dh / numce_dh 
     602         WRITE(numout,*) ' Number of points where there is bas. me. error : ', numce_dh 
     603         WRITE(numout,*) ' Mean basal melt error on error points : ', meance_dh 
     604         WRITE(numout,*) ' Remaining bottom heat : ', zqfont_bo(jiindex_1d) 
    610605 
    611606      ENDIF ! con_i 
    612607 
    613 ! 
    614 !------------------------------------------------------------------------------! 
    615 !  5) Pathological cases                                                       ! 
    616 !------------------------------------------------------------------------------! 
    617 ! 
     608      ! 
     609      !------------------------------------------------------------------------------! 
     610      !  5) Pathological cases                                                       ! 
     611      !------------------------------------------------------------------------------! 
     612      ! 
    618613      !---------------------------------------------- 
    619614      ! 5.1 Excessive ablation in a 1-category model 
    … …  
    626621         ! excessive energy is sent to lateral ablation 
    627622         fsup(ji)            =  rhoic*lfus * at_i_b(ji) / MAX( ( 1.0 - at_i_b(ji) ),epsi13) & 
    628                              *  ( zdhbf - dh_i_bott(ji) ) / rdt_ice 
     623            *  ( zdhbf - dh_i_bott(ji) ) / rdt_ice 
    629624 
    630625         dh_i_bott(ji)  = zdhbf 
    … …  
    638633         zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    639634         diag_bot_gr(zji,zjj) = diag_bot_gr(zji,zjj) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) & 
    640                               / rdt_ice 
     635            / rdt_ice 
    641636         diag_sur_me(zji,zjj) = diag_sur_me(zji,zjj) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) & 
    642                               / rdt_ice 
     637            / rdt_ice 
    643638         diag_bot_me(zji,zjj) = diag_bot_me(zji,zjj) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) & 
    644                               / rdt_ice 
     639            / rdt_ice 
    645640      END DO 
    646641 
    … …  
    667662         zqt_s(ji)  =  ( 1. - zihg) * zqt_s(ji) / MAX( zhni, zeps ) 
    668663         zdhnm      =  - ( 1. - zihg ) * ( 1. - zihgnew ) * ( zfdt_final(ji) /  & 
    669                            MAX( zqt_s(ji) , zeps ) ) 
     664            MAX( zqt_s(ji) , zeps ) ) 
    670665         zhnfi          =  zhni + zdhnm 
    671666         zfdt_final(ji) =  MAX ( zfdt_final(ji) + zqt_s(ji) * zdhnm , 0.0 ) 
    … …  
    676671         !--------------------------------- 
    677672         rdmicif_1d(ji) =  rdmicif_1d(ji) + a_i_b(ji) *                        & 
    678                            (zhgnew(ji)-ht_i_b(ji))*rhoic ! good 
     673            (zhgnew(ji)-ht_i_b(ji))*rhoic ! good 
    679674 
    680675         rdmsnif_1d(ji) =  rdmsnif_1d(ji) + a_i_b(ji) * & 
    681                            (ht_s_b(ji)-zhni)*rhosn ! good too 
     676            (ht_s_b(ji)-zhni)*rhosn ! good too 
    682677 
    683678         ! Remaining heat to the ocean  
    … …  
    700695         zjj           = ( npb(ji) - 1 ) / jpi + 1 
    701696         IF ( num_sal .NE. 4 ) & 
    702          fseqv_1d(ji)  = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) +           & 
    703                           (1.0 - zihgnew) * rdmicif_1d(ji) *                  & 
    704                           ( sss_m(zji,zjj) - sm_i_b(ji) ) / rdt_ice 
     697            fseqv_1d(ji)  = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) +           & 
     698            (1.0 - zihgnew) * rdmicif_1d(ji) *                  & 
     699            ( sss_m(zji,zjj) - sm_i_b(ji) ) / rdt_ice 
    705700         ! new lines 
    706701         IF ( num_sal .EQ. 4 ) & 
    707          fseqv_1d(ji)  = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) +           & 
    708                           (1.0 - zihgnew) * rdmicif_1d(ji) *                  & 
    709                           ( sss_m(zji,zjj) - bulk_sal ) / rdt_ice 
     702            fseqv_1d(ji)  = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) +           & 
     703            (1.0 - zihgnew) * rdmicif_1d(ji) *                  & 
     704            ( sss_m(zji,zjj) - bulk_sal ) / rdt_ice 
    710705         ! Heat flux 
    711706         ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 
    712707         ! excessive total ablation energy (focea) sent to the ocean 
    713708         qfvbq_1d(ji)  = qfvbq_1d(ji) + & 
    714                          fsup(ji) + ( 1.0 - zihgnew ) *        &  
    715                          focea(ji) * a_i_b(ji) * rdt_ice 
     709            fsup(ji) + ( 1.0 - zihgnew ) *        &  
     710            focea(ji) * a_i_b(ji) * rdt_ice 
    716711 
    717712         zihic   = 1.0 - MAX( zzero , SIGN( zone , -ht_i_b(ji) ) ) 
    … …  
    719714         fscbq_1d(ji) =  a_i_b(ji) * fstbif_1d(ji) 
    720715         qldif_1d(ji)  = qldif_1d(ji)                                         & 
    721                        + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji) * a_i_b(ji) &  
    722                          * rdt_ice                               & 
    723                        + ( 1.0 - zihic ) * fscbq_1d(ji) * rdt_ice 
     716            + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji) * a_i_b(ji) &  
     717            * rdt_ice                               & 
     718            + ( 1.0 - zihic ) * fscbq_1d(ji) * rdt_ice 
    724719      END DO  ! ji 
    725720 
    … …  
    743738         ht_i_b(ji) = zhgnew(ji) 
    744739      END DO  ! ji 
    745 ! 
    746 !------------------------------------------------------------------------------| 
    747 !  6) Snow-Ice formation                                                       | 
    748 !------------------------------------------------------------------------------| 
    749 ! 
     740      ! 
     741      !------------------------------------------------------------------------------| 
     742      !  6) Snow-Ice formation                                                       | 
     743      !------------------------------------------------------------------------------| 
     744      ! 
    750745      ! When snow load excesses Archimede's limit, snow-ice interface goes down 
    751746      ! under sea-level, flooding of seawater transforms snow into ice 
    … …  
    754749 
    755750         dh_snowice(ji) = MAX(zzero,(rhosn*ht_s_b(ji)+(rhoic-rau0) & 
    756                             * ht_i_b(ji))/(rhosn+rau0-rhoic)) 
     751            * ht_i_b(ji))/(rhosn+rau0-rhoic)) 
    757752         zhgnew(ji)     = MAX(zhgnew(ji),zhgnew(ji)+dh_snowice(ji)) 
    758753         zhnnew            = MIN(ht_s_b(ji),ht_s_b(ji)-dh_snowice(ji)) 
    759754 
    760       !  Changes in ice volume and ice mass. 
     755         !  Changes in ice volume and ice mass. 
    761756         dvnbq_1d(ji)      = a_i_b(ji) * (zhgnew(ji)-ht_i_b(ji)) 
    762757         dmgwi_1d(ji)      = dmgwi_1d(ji) + a_i_b(ji) & 
    763                              *(ht_s_b(ji)-zhnnew)*rhosn 
     758            *(ht_s_b(ji)-zhnnew)*rhosn 
    764759 
    765760         rdmicif_1d(ji) = rdmicif_1d(ji) + a_i_b(ji) &  
    766                                          * ( zhgnew(ji) - ht_i_b(ji) )*rhoic  
     761            * ( zhgnew(ji) - ht_i_b(ji) )*rhoic  
    767762         rdmsnif_1d(ji) = rdmsnif_1d(ji) + a_i_b(ji) &  
    768                                          * ( zhnnew       - ht_s_b(ji) )*rhosn 
    769  
    770 !        Equivalent salt flux (1) Snow-ice formation component 
    771 !        ----------------------------------------------------- 
     763            * ( zhnnew       - ht_s_b(ji) )*rhosn 
     764 
     765         !        Equivalent salt flux (1) Snow-ice formation component 
     766         !        ----------------------------------------------------- 
    772767         zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    773768         zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    774769 
    775770         zsm_snowice  = ( rhoic - rhosn ) / rhoic *            & 
    776                         sss_m(zji,zjj)  
     771            sss_m(zji,zjj)  
    777772 
    778773         IF ( num_sal .NE. 2 ) zsm_snowice = sm_i_b(ji) 
    779774 
    780775         IF ( num_sal .NE. 4 ) & 
    781          fseqv_1d(ji)   = fseqv_1d(ji)   + & 
    782                           ( sss_m(zji,zjj) - zsm_snowice ) * & 
    783                             a_i_b(ji)   * & 
    784                           ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
     776            fseqv_1d(ji)   = fseqv_1d(ji)   + & 
     777            ( sss_m(zji,zjj) - zsm_snowice ) * & 
     778            a_i_b(ji)   * & 
     779            ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
    785780         ! new lines 
    786781         IF ( num_sal .EQ. 4 ) & 
    787          fseqv_1d(ji)   = fseqv_1d(ji)   + & 
    788                           ( sss_m(zji,zjj) - bulk_sal    ) * & 
    789                             a_i_b(ji)   * & 
    790                           ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
     782            fseqv_1d(ji)   = fseqv_1d(ji)   + & 
     783            ( sss_m(zji,zjj) - bulk_sal    ) * & 
     784            a_i_b(ji)   * & 
     785            ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
    791786 
    792787         ! entrapment during snow ice formation 
    793788         i_ice_switch = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_i_b(ji) + 1.0e-6 ) ) 
    794789         isnowic      = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - dh_snowice(ji) ) ) * & 
    795                         i_ice_switch 
     790            i_ice_switch 
    796791         IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 
    797              dsm_i_si_1d(ji)  = ( zsm_snowice*dh_snowice(ji) & 
    798                             + sm_i_b(ji) * ht_i_b(ji)                          &  
    799                             / MAX( ht_i_b(ji) + dh_snowice(ji), zeps)          & 
    800                             - sm_i_b(ji) ) * isnowic      
    801  
    802 !  Actualize new snow and ice thickness. 
     792            dsm_i_si_1d(ji)  = ( zsm_snowice*dh_snowice(ji) & 
     793            + sm_i_b(ji) * ht_i_b(ji)                          &  
     794            / MAX( ht_i_b(ji) + dh_snowice(ji), zeps)          & 
     795            - sm_i_b(ji) ) * isnowic      
     796 
     797         !  Actualize new snow and ice thickness. 
    803798         ht_s_b(ji)  = zhnnew 
    804799         ht_i_b(ji)  = zhgnew(ji) 
    … …  
    811806         zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    812807         diag_sni_gr(zji,zjj)  = diag_sni_gr(zji,zjj) + dh_snowice(ji)*a_i_b(ji) / & 
    813                                  rdt_ice 
     808            rdt_ice 
    814809 
    815810      END DO !ji 
    816811 
    817     END SUBROUTINE lim_thd_dh 
     812   END SUBROUTINE lim_thd_dh 
    818813#else 
    819814   !!====================================================================== 
    … …  
    825820   END SUBROUTINE lim_thd_dh 
    826821#endif 
    827  END MODULE limthd_dh 
     822END MODULE limthd_dh 

  • trunk/NEMO/LIM_SRC_3/limthd_dif.F90

    r869 r921  
    2222   USE par_ice 
    2323   USE lib_mpp  
    24   
     24 
    2525   IMPLICIT NONE 
    2626   PRIVATE 
    … …  
    4444 
    4545   SUBROUTINE lim_thd_dif( kideb , kiut , jl ) 
    46         !!------------------------------------------------------------------ 
    47         !!                ***  ROUTINE lim_thd_dif  *** 
    48         !! ** Purpose : 
    49         !!           This routine determines the time evolution of snow and sea-ice  
    50         !!           temperature profiles. 
    51         !! ** Method  : 
    52         !!           This is done by solving the heat equation diffusion with 
    53         !!           a Neumann boundary condition at the surface and a Dirichlet one 
    54         !!           at the bottom. Solar radiation is partially absorbed into the ice. 
    55         !!           The specific heat and thermal conductivities depend on ice salinity 
    56         !!           and temperature to take into account brine pocket melting. The  
    57         !!           numerical 
    58         !!           scheme is an iterative Crank-Nicolson on a non-uniform multilayer grid  
    59         !!           in the ice and snow system. 
    60         !! 
    61         !!           The successive steps of this routine are 
    62         !!           1.  Thermal conductivity at the interfaces of the ice layers 
    63         !!           2.  Internal absorbed radiation 
    64         !!           3.  Scale factors due to non-uniform grid 
    65         !!           4.  Kappa factors 
    66         !!           Then iterative procedure begins 
    67         !!           5.  specific heat in the ice 
    68         !!           6.  eta factors 
    69         !!           7.  surface flux computation 
    70         !!           8.  tridiagonal system terms 
    71         !!           9.  solving the tridiagonal system with Gauss elimination 
    72         !!           Iterative procedure ends according to a criterion on evolution 
    73         !!           of temperature 
    74         !! 
    75         !! ** Arguments : 
    76         !!           kideb , kiut : Starting and ending points on which the  
    77         !!                         the computation is applied 
    78         !! 
    79         !! ** Inputs / Ouputs : (global commons) 
    80         !!           surface temperature : t_su_b 
    81         !!           ice/snow temperatures   : t_i_b, t_s_b 
    82         !!           ice salinities          : s_i_b 
    83         !!           number of layers in the ice/snow: nlay_i, nlay_s 
    84         !!           profile of the ice/snow layers : z_i, z_s 
    85         !!           total ice/snow thickness : ht_i_b, ht_s_b 
    86         !! 
    87         !! ** External :  
    88         !! 
    89         !! ** References : 
    90         !! 
    91         !! ** History : 
    92         !!           (02-2003) Martin Vancoppenolle, Louvain-la-Neuve, Belgium 
    93         !!           (06-2005) Martin Vancoppenolle, 3d version 
    94         !!           (11-2006) Vectorized by Xavier Fettweis (UCL-ASTR) 
    95         !!           (04-2007) Energy conservation tested by M. Vancoppenolle 
    96         !! 
    97         !!------------------------------------------------------------------ 
    98         !! * Arguments 
    99  
    100        INTEGER , INTENT (in) ::  & 
    101           kideb ,  &  ! Start point on which the  the computation is applied 
    102           kiut  ,  &  ! End point on which the  the computation is applied 
    103           jl          ! Category number 
    104  
    105        !! * Local variables 
    106        INTEGER ::   ji,       &   ! spatial loop index 
    107                     zji, zjj, &   ! temporary dummy loop index 
    108                     numeq,    &   ! current reference number of equation 
    109                     layer,    &   ! vertical dummy loop index  
    110                     nconv,    &   ! number of iterations in iterative procedure 
    111                     minnumeqmin, & ! 
    112                     maxnumeqmax 
    113  
    114        INTEGER , DIMENSION(jpij) :: & 
    115                     numeqmin, &   ! reference number of top equation 
    116                     numeqmax, &   ! reference number of bottom equation 
    117                     isnow         ! switch for presence (1) or absence (0) of snow 
    118  
    119        !! * New local variables        
    120        REAL(wp) , DIMENSION(jpij,0:nlay_i) ::    & 
    121           ztcond_i,    & !Ice thermal conductivity 
    122           zradtr_i,    & !Radiation transmitted through the ice 
    123           zradab_i,    & !Radiation absorbed in the ice 
    124           zkappa_i       !Kappa factor in the ice 
    125  
    126        REAL(wp) , DIMENSION(jpij,0:nlay_s) ::    & 
    127           zradtr_s,    & !Radiation transmited through the snow 
    128           zradab_s,    & !Radiation absorbed in the snow 
    129           zkappa_s       !Kappa factor in the snow 
    130         
    131        REAL(wp) , DIMENSION(jpij,0:nlay_i) :: & 
    132           ztiold,      & !Old temperature in the ice 
    133           zeta_i,      & !Eta factor in the ice  
    134           ztitemp,     & !Temporary temperature in the ice to check the convergence 
    135           zspeche_i,   & !Ice specific heat 
    136           z_i            !Vertical cotes of the layers in the ice 
    137  
    138        REAL(wp) , DIMENSION(jpij,0:nlay_s) :: & 
    139           zeta_s,      & !Eta factor in the snow 
    140           ztstemp,     & !Temporary temperature in the snow to check the convergence 
    141           ztsold,      & !Temporary temperature in the snow 
    142           z_s            !Vertical cotes of the layers in the snow 
    143  
    144        REAL(wp) , DIMENSION(jpij,jkmax+2) ::    & 
    145           zindterm,    & ! Independent term 
    146           zindtbis,    & ! temporary independent term 
    147           zdiagbis 
    148  
    149        REAL(wp) , DIMENSION(jpij,jkmax+2,3) ::  & 
    150           ztrid          ! tridiagonal system terms 
    151            
    152        REAL(wp), DIMENSION(jpij) ::  & 
    153           ztfs     ,   & ! ice melting point 
    154           ztsuold  ,   & ! old surface temperature (before the iterative 
    155                          !          procedure ) 
    156           ztsuoldit,   & ! surface temperature at previous iteration 
    157           zh_i     ,   & !ice layer thickness 
    158           zh_s     ,   & !snow layer thickness 
    159           zfsw     ,   & !solar radiation absorbed at the surface 
    160           zf       ,   & ! surface flux function 
    161           dzf            ! derivative of the surface flux function 
    162  
    163        REAL(wp)  ::           &  ! constant values 
    164           zeps      =  1.0e-10,   & ! 
    165           zg1s      =  2.0,       & !: for the tridiagonal system 
    166           zg1       =  2.0,       & 
    167           zgamma    =  18009.0,   & !: for specific heat 
    168           zbeta     =  0.117,     & !: for thermal conductivity (could be 0.13) 
    169           zraext_s  =  1.0e08,    & !: extinction coefficient of radiation in the snow 
    170           zkimin    =  0.10 ,     & !: minimum ice thermal conductivity 
    171           zht_smin  =  1.0e-4       !: minimum snow depth 
    172  
    173         REAL(wp)  ::          &  ! local variables  
    174           ztmelt_i,           &  ! ice melting temperature 
    175           zerritmax              ! current maximal error on temperature  
    176  
    177         REAL(wp), DIMENSION(jpij)  :: & 
    178           zerrit,             &  ! current error on temperature  
    179           zdifcase,           &  ! case of the equation resolution (1->4) 
    180           zftrice,            &  ! solar radiation transmitted through the ice 
    181           zihic, zhsu 
    182  
    183 !!-- End of declarations 
    184 !!---------------------------------------------------------------------------------------------- 
    185  
    186        IF(lwp) WRITE(numout,*)'lim_thd_dif : Heat diffusion in sea ice for cat :', jl 
    187  
    188 ! 
    189 !------------------------------------------------------------------------------! 
    190 ! 1) Initialization                                                            ! 
    191 !------------------------------------------------------------------------------! 
    192 ! 
    193        DO ji = kideb , kiut 
    194           ! is there snow or not 
    195           isnow(ji)= INT ( 1.0 - MAX( 0.0 , SIGN (1.0, - ht_s_b(ji) ) ) ) 
    196           ! surface temperature of fusion 
    197           ztfs(ji) = isnow(ji) * rtt + (1.0-isnow(ji)) * rtt 
    198           ! layer thickness 
    199           zh_i(ji)              = ht_i_b(ji) / nlay_i 
    200           zh_s(ji)              = ht_s_b(ji) / nlay_s 
    201        END DO 
    202  
    203        !-------------------- 
    204        ! Ice / snow layers 
    205        !-------------------- 
    206  
    207        z_s(:,0)      = 0.0 ! vert. coord. of the up. lim. of the 1st snow layer 
    208        z_i(:,0)      = 0.0 ! vert. coord. of the up. lim. of the 1st ice layer 
    209  
    210        DO layer = 1, nlay_s 
    211           DO ji = kideb , kiut 
    212              ! vert. coord of the up. lim. of the layer-th snow layer 
    213              z_s(ji,layer)      = z_s(ji,layer-1) + ht_s_b(ji) / nlay_s 
    214           END DO  
    215        END DO 
    216  
    217        DO layer = 1, nlay_i 
    218           DO ji = kideb , kiut 
    219              ! vert. coord of the up. lim. of the layer-th ice layer 
    220              z_i(ji,layer)      = z_i(ji,layer-1) + ht_i_b(ji) / nlay_i 
    221           END DO 
    222        END DO 
    223 ! 
    224 !------------------------------------------------------------------------------| 
    225 ! 2) Radiations                                                                | 
    226 !------------------------------------------------------------------------------| 
    227 ! 
    228        !------------------- 
    229        ! Computation of i0 
    230        !------------------- 
    231        ! i0 describes the fraction of solar radiation which does not contribute 
    232        ! to the surface energy budget but rather penetrates inside the ice. 
    233        ! We assume that no radiation is transmitted through the snow 
    234        ! If there is no no snow 
    235        ! zfsw    = (1-i0).qsr_ice   is absorbed at the surface  
    236        ! zftrice = io.qsr_ice       is below the surface  
    237        ! fstbif  = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
    238  
    239        DO ji = kideb , kiut 
    240           ! switches 
    241           isnow(ji)  = INT ( 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s_b(ji) ) ) )  
    242                      ! hs > 0, isnow = 1 
    243           zhsu(ji)   = hnzst  !threshold for the computation of i0 
    244           zihic(ji)  = MAX( zzero , 1.0 - ( ht_i_b(ji) / zhsu(ji) ) )      
    245   
    246           i0(ji)     = ( 1.0 - isnow(ji) ) * & 
    247                        ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 
    248                  !fr1_i0_1d = i0 for a thin ice surface 
    249                  !fr1_i0_2d = i0 for a thick ice surface 
    250                  !            a function of the cloud cover 
    251           ! 
    252           !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_b(ji)+10.0) 
    253           !formula used in Cice 
    254        END DO 
    255  
    256        !------------------------------------------------------- 
    257        ! Solar radiation absorbed / transmitted at the surface 
    258        ! Derivative of the non solar flux 
    259        !------------------------------------------------------- 
    260        DO ji = kideb , kiut 
    261  
    262           ! Shortwave radiation absorbed at surface 
    263           zfsw(ji)   =  qsr_ice_1d(ji) * ( 1 - i0(ji) ) 
    264  
    265           ! Solar radiation transmitted below the surface layer 
    266           zftrice(ji)=  qsr_ice_1d(ji) * i0(ji) 
    267  
    268           ! derivative of incoming nonsolar flux  
    269           dzf(ji)   =    dqns_ice_1d(ji)   
    270  
    271        END DO 
    272  
    273        !--------------------------------------------------------- 
    274        ! Transmission - absorption of solar radiation in the ice 
    275        !--------------------------------------------------------- 
    276  
    277        DO ji = kideb , kiut 
    278           ! Initialization 
    279           zradtr_s(ji,0) = zftrice(ji) ! radiation penetrating through snow 
    280        END DO 
    281  
    282        ! Radiation through snow 
    283        DO layer = 1, nlay_s 
    284           DO ji = kideb , kiut 
    285              ! radiation transmitted below the layer-th snow layer 
    286              zradtr_s(ji,layer) = zradtr_s(ji,0) * EXP ( - zraext_s * ( MAX ( 0.0 , & 
    287                                   z_s(ji,layer) ) ) ) 
    288              ! radiation absorbed by the layer-th snow layer 
    289              zradab_s(ji,layer) = zradtr_s(ji,layer-1) - zradtr_s(ji,layer) 
    290           END DO  
    291        END DO 
    292  
    293        ! Radiation through ice 
    294        DO ji = kideb , kiut 
    295           zradtr_i(ji,0)        = zradtr_s(ji,nlay_s) * isnow(ji) + &  
    296                                   zftrice(ji) * ( 1 - isnow(ji) ) 
    297        END DO 
    298  
    299        DO layer = 1, nlay_i 
    300           DO ji = kideb , kiut 
    301              ! radiation transmitted below the layer-th ice layer 
    302              zradtr_i(ji,layer) = zradtr_i(ji,0) * EXP ( - kappa_i * ( MAX ( 0.0 , & 
    303                                   z_i(ji,layer) ) ) ) 
    304              ! radiation absorbed by the layer-th ice layer 
    305              zradab_i(ji,layer) = zradtr_i(ji,layer-1) - zradtr_i(ji,layer) 
    306           END DO 
    307        END DO 
    308  
    309        ! Radiation transmitted below the ice 
    310        DO ji = kideb , kiut 
    311           fstbif_1d(ji)  =  fstbif_1d(ji) + & 
    312                             zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) 
    313        END DO 
    314  
    315        ! +++++ 
    316        ! just to check energy conservation 
    317        DO ji = kideb , kiut 
    318           zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    319           zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    320           fstroc(zji,zjj,jl)  = & 
    321                         zradtr_i(ji,nlay_i) 
    322        END DO 
    323        ! +++++ 
    324  
    325        DO layer = 1, nlay_i 
    326           DO ji = kideb , kiut 
    327              radab(ji,layer) = zradab_i(ji,layer) 
    328           END DO 
    329        END DO 
    330  
    331         
    332 ! 
    333 !------------------------------------------------------------------------------| 
    334 !  3) Iterative procedure begins                                               | 
    335 !------------------------------------------------------------------------------| 
    336 ! 
    337        ! Old surface temperature 
    338        DO ji = kideb, kiut 
    339           ztsuold(ji)          =  t_su_b(ji) ! temperature at the beg of iter pr. 
    340           ztsuoldit(ji)        =  t_su_b(ji) ! temperature at the previous iter 
    341           t_su_b(ji)           =  MIN(t_su_b(ji),ztfs(ji)-0.00001) !necessary 
    342           zerrit(ji)           =  1000.0     ! initial value of error 
    343        END DO 
    344 !RB Min global ?? 
    345  
    346        ! Old snow temperature 
    347        DO layer = 1, nlay_s 
    348           DO ji = kideb , kiut 
    349              ztsold(ji,layer)     =  t_s_b(ji,layer) 
    350           END DO 
    351        END DO 
    352            
    353        ! Old ice temperature 
    354        DO layer = 1, nlay_i 
    355           DO ji = kideb , kiut 
    356              ztiold(ji,layer)     =  t_i_b(ji,layer) 
    357           END DO 
    358        END DO 
    359  
    360        nconv     =  0         ! number of iterations 
    361        zerritmax =  1000.0    ! maximal value of error on all points 
    362  
    363        DO WHILE ((zerritmax > maxer_i_thd).AND.(nconv < nconv_i_thd)) 
    364  
    365        nconv   =  nconv+1 
    366  
    367 ! 
    368 !------------------------------------------------------------------------------| 
    369 ! 4) Sea ice thermal conductivity                                              | 
    370 !------------------------------------------------------------------------------| 
    371 ! 
    372        IF ( thcon_i_swi .EQ. 0 ) THEN 
    373        ! Untersteiner (1964) formula 
    374        DO ji = kideb , kiut 
    375           ztcond_i(ji,0)        = rcdic + zbeta*s_i_b(ji,1) / & 
    376                                   MIN(-zeps,t_i_b(ji,1)-rtt) 
    377           ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin) 
    378        END DO 
    379        ENDIF 
    380  
    381        IF ( thcon_i_swi .EQ. 1 ) THEN 
    382        ! Pringle et al formula included, 
    383        ! 2.11 + 0.09 S/T - 0.011.T 
    384        DO ji = kideb , kiut 
    385           ztcond_i(ji,0)        = rcdic + 0.09*s_i_b(ji,1) / & 
    386                                   MIN(-zeps,t_i_b(ji,1)-rtt) - & 
    387                                   0.011* ( t_i_b(ji,1) - rtt )   
    388           ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin) 
    389        END DO 
    390        ENDIF 
    391  
    392        IF ( thcon_i_swi .EQ. 0 ) THEN ! Untersteiner 
    393        DO layer = 1, nlay_i-1 
    394           DO ji = kideb , kiut 
    395              ztcond_i(ji,layer) = rcdic + zbeta*( s_i_b(ji,layer) & 
    396                            + s_i_b(ji,layer+1) ) / MIN(-zeps,     & 
    397                            t_i_b(ji,layer)+t_i_b(ji,layer+1)-2.0*rtt) 
    398              ztcond_i(ji,layer)   = MAX(ztcond_i(ji,layer),zkimin) 
    399           END DO 
    400        END DO 
    401        ENDIF 
    402  
    403        IF ( thcon_i_swi .EQ. 1 ) THEN ! Pringle 
    404        DO layer = 1, nlay_i-1 
    405           DO ji = kideb , kiut 
    406              ztcond_i(ji,layer) = rcdic + 0.09*( s_i_b(ji,layer)   & 
    407                            + s_i_b(ji,layer+1) ) / MIN(-zeps,      & 
    408                            t_i_b(ji,layer)+t_i_b(ji,layer+1)-2.0*rtt) - & 
    409                            0.011* ( t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2.0*rtt )   
    410              ztcond_i(ji,layer) = MAX(ztcond_i(ji,layer),zkimin) 
    411           END DO 
    412        END DO 
    413        ENDIF 
    414  
    415        IF ( thcon_i_swi .EQ. 0 ) THEN ! Untersteiner 
    416        DO ji = kideb , kiut 
    417           ztcond_i(ji,nlay_i)   = rcdic + zbeta*s_i_b(ji,nlay_i) / & 
    418                            MIN(-zeps,t_bo_b(ji)-rtt) 
    419           ztcond_i(ji,nlay_i)   = MAX(ztcond_i(ji,nlay_i),zkimin) 
    420        END DO 
    421        ENDIF 
    422  
    423        IF ( thcon_i_swi .EQ. 1 ) THEN ! Pringle 
    424        DO ji = kideb , kiut 
    425           ztcond_i(ji,nlay_i)   = rcdic + 0.09*s_i_b(ji,nlay_i) / & 
    426                                   MIN(-zeps,t_bo_b(ji)-rtt) - & 
    427                                   0.011* ( t_bo_b(ji) - rtt )   
    428           ztcond_i(ji,nlay_i)   = MAX(ztcond_i(ji,nlay_i),zkimin) 
    429        END DO 
    430        ENDIF 
    431 ! 
    432 !------------------------------------------------------------------------------| 
    433 !  5) kappa factors                                                            | 
    434 !------------------------------------------------------------------------------| 
    435 ! 
    436        DO ji = kideb, kiut 
    437  
    438        !-- Snow kappa factors 
    439           zkappa_s(ji,0)         = rcdsn / MAX(zeps,zh_s(ji)) 
    440           zkappa_s(ji,nlay_s)    = rcdsn / MAX(zeps,zh_s(ji)) 
    441        END DO 
    442  
    443        DO layer = 1, nlay_s-1 
    444           DO ji = kideb , kiut 
    445              zkappa_s(ji,layer)  = 2.0 * rcdsn / & 
    446              MAX(zeps,2.0*zh_s(ji)) 
    447           END DO  
    448        END DO 
    449  
    450        DO layer = 1, nlay_i-1 
    451           DO ji = kideb , kiut 
    452           !-- Ice kappa factors 
    453              zkappa_i(ji,layer)  = 2.0*ztcond_i(ji,layer)/ & 
    454              MAX(zeps,2.0*zh_i(ji))  
    455           END DO  
    456        END DO 
    457  
    458        DO ji = kideb , kiut 
    459           zkappa_i(ji,0)        = ztcond_i(ji,0)/MAX(zeps,zh_i(ji)) 
    460           zkappa_i(ji,nlay_i)   = ztcond_i(ji,nlay_i) / MAX(zeps,zh_i(ji)) 
    461        !-- Interface 
    462           zkappa_s(ji,nlay_s)   = 2.0*rcdsn*ztcond_i(ji,0)/MAX(zeps, & 
    463                        (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji))) 
    464           zkappa_i(ji,0)        = zkappa_s(ji,nlay_s)*isnow(ji) & 
    465                                 + zkappa_i(ji,0)*(1.0-isnow(ji)) 
    466        END DO 
    467 ! 
    468 !------------------------------------------------------------------------------| 
    469 ! 6) Sea ice specific heat, eta factors                                        | 
    470 !------------------------------------------------------------------------------| 
    471 ! 
    472           DO layer = 1, nlay_i 
    473              DO ji = kideb , kiut 
    474                 ztitemp(ji,layer)   = t_i_b(ji,layer) 
    475                 zspeche_i(ji,layer) = cpic + zgamma*s_i_b(ji,layer)/ & 
    476                 MAX((t_i_b(ji,layer)-rtt)*(ztiold(ji,layer)-rtt),zeps) 
    477                 zeta_i(ji,layer)    = rdt_ice / MAX(rhoic*zspeche_i(ji,layer)*zh_i(ji), & 
    478                                               zeps) 
    479              END DO 
    480           END DO 
    481  
    482           DO layer = 1, nlay_s 
    483              DO ji = kideb , kiut 
    484                 ztstemp(ji,layer) = t_s_b(ji,layer) 
    485                 zeta_s(ji,layer)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),zeps) 
    486              END DO 
    487           END DO 
    488 ! 
    489 !------------------------------------------------------------------------------| 
    490 ! 7) surface flux computation                                                  | 
    491 !------------------------------------------------------------------------------| 
    492 ! 
    493           DO ji = kideb , kiut 
    494  
    495           ! update of the non solar flux according to the update in T_su 
    496              qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * &  
    497                                ( t_su_b(ji) - ztsuoldit(ji) ) 
    498  
    499           ! update incoming flux 
    500              zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation 
    501                        + qnsr_ice_1d(ji)           ! non solar total flux  
    502                                                    ! (LWup, LWdw, SH, LH) 
    503  
    504           END DO 
    505  
    506 ! 
    507 !------------------------------------------------------------------------------| 
    508 ! 8) tridiagonal system terms                                                  | 
    509 !------------------------------------------------------------------------------| 
    510 ! 
    511 !!layer denotes the number of the layer in the snow or in the ice 
    512 !!numeq denotes the reference number of the equation in the tridiagonal 
    513 !!system, terms of tridiagonal system are indexed as following : 
    514 !!1 is subdiagonal term, 2 is diagonal and 3 is superdiagonal one 
    515  
    516 !!ice interior terms (top equation has the same form as the others) 
    517  
    518           DO numeq=1,jkmax+2 
    519              DO ji = kideb , kiut 
    520                 ztrid(ji,numeq,1) = 0. 
    521                 ztrid(ji,numeq,2) = 0. 
    522                 ztrid(ji,numeq,3) = 0. 
    523                 zindterm(ji,numeq)= 0. 
    524                 zindtbis(ji,numeq)= 0. 
    525                 zdiagbis(ji,numeq)= 0. 
    526              ENDDO 
    527           ENDDO 
    528  
    529           DO numeq = nlay_s + 2, nlay_s + nlay_i  
    530              DO ji = kideb , kiut 
    531                 layer              = numeq - nlay_s - 1 
    532                 ztrid(ji,numeq,1)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer-1) 
    533                 ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,layer)*(zkappa_i(ji,layer-1) + & 
    534                                       zkappa_i(ji,layer)) 
    535                 ztrid(ji,numeq,3)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer) 
    536                 zindterm(ji,numeq) =  ztiold(ji,layer) + zeta_i(ji,layer)* & 
    537                                       zradab_i(ji,layer) 
    538              END DO 
    539           ENDDO 
    540  
    541           numeq =  nlay_s + nlay_i + 1 
    542           DO ji = kideb , kiut 
     46      !!------------------------------------------------------------------ 
     47      !!                ***  ROUTINE lim_thd_dif  *** 
     48      !! ** Purpose : 
     49      !!           This routine determines the time evolution of snow and sea-ice  
     50      !!           temperature profiles. 
     51      !! ** Method  : 
     52      !!           This is done by solving the heat equation diffusion with 
     53      !!           a Neumann boundary condition at the surface and a Dirichlet one 
     54      !!           at the bottom. Solar radiation is partially absorbed into the ice. 
     55      !!           The specific heat and thermal conductivities depend on ice salinity 
     56      !!           and temperature to take into account brine pocket melting. The  
     57      !!           numerical 
     58      !!           scheme is an iterative Crank-Nicolson on a non-uniform multilayer grid  
     59      !!           in the ice and snow system. 
     60      !! 
     61      !!           The successive steps of this routine are 
     62      !!           1.  Thermal conductivity at the interfaces of the ice layers 
     63      !!           2.  Internal absorbed radiation 
     64      !!           3.  Scale factors due to non-uniform grid 
     65      !!           4.  Kappa factors 
     66      !!           Then iterative procedure begins 
     67      !!           5.  specific heat in the ice 
     68      !!           6.  eta factors 
     69      !!           7.  surface flux computation 
     70      !!           8.  tridiagonal system terms 
     71      !!           9.  solving the tridiagonal system with Gauss elimination 
     72      !!           Iterative procedure ends according to a criterion on evolution 
     73      !!           of temperature 
     74      !! 
     75      !! ** Arguments : 
     76      !!           kideb , kiut : Starting and ending points on which the  
     77      !!                         the computation is applied 
     78      !! 
     79      !! ** Inputs / Ouputs : (global commons) 
     80      !!           surface temperature : t_su_b 
     81      !!           ice/snow temperatures   : t_i_b, t_s_b 
     82      !!           ice salinities          : s_i_b 
     83      !!           number of layers in the ice/snow: nlay_i, nlay_s 
     84      !!           profile of the ice/snow layers : z_i, z_s 
     85      !!           total ice/snow thickness : ht_i_b, ht_s_b 
     86      !! 
     87      !! ** External :  
     88      !! 
     89      !! ** References : 
     90      !! 
     91      !! ** History : 
     92      !!           (02-2003) Martin Vancoppenolle, Louvain-la-Neuve, Belgium 
     93      !!           (06-2005) Martin Vancoppenolle, 3d version 
     94      !!           (11-2006) Vectorized by Xavier Fettweis (UCL-ASTR) 
     95      !!           (04-2007) Energy conservation tested by M. Vancoppenolle 
     96      !! 
     97      !!------------------------------------------------------------------ 
     98      !! * Arguments 
     99 
     100      INTEGER , INTENT (in) ::  & 
     101         kideb ,  &  ! Start point on which the  the computation is applied 
     102         kiut  ,  &  ! End point on which the  the computation is applied 
     103         jl          ! Category number 
     104 
     105      !! * Local variables 
     106      INTEGER ::   ji,       &   ! spatial loop index 
     107         zji, zjj, &   ! temporary dummy loop index 
     108         numeq,    &   ! current reference number of equation 
     109         layer,    &   ! vertical dummy loop index  
     110         nconv,    &   ! number of iterations in iterative procedure 
     111         minnumeqmin, & ! 
     112         maxnumeqmax 
     113 
     114      INTEGER , DIMENSION(jpij) :: & 
     115         numeqmin, &   ! reference number of top equation 
     116         numeqmax, &   ! reference number of bottom equation 
     117         isnow         ! switch for presence (1) or absence (0) of snow 
     118 
     119      !! * New local variables        
     120      REAL(wp) , DIMENSION(jpij,0:nlay_i) ::    & 
     121         ztcond_i,    & !Ice thermal conductivity 
     122         zradtr_i,    & !Radiation transmitted through the ice 
     123         zradab_i,    & !Radiation absorbed in the ice 
     124         zkappa_i       !Kappa factor in the ice 
     125 
     126      REAL(wp) , DIMENSION(jpij,0:nlay_s) ::    & 
     127         zradtr_s,    & !Radiation transmited through the snow 
     128         zradab_s,    & !Radiation absorbed in the snow 
     129         zkappa_s       !Kappa factor in the snow 
     130 
     131      REAL(wp) , DIMENSION(jpij,0:nlay_i) :: & 
     132         ztiold,      & !Old temperature in the ice 
     133         zeta_i,      & !Eta factor in the ice  
     134         ztitemp,     & !Temporary temperature in the ice to check the convergence 
     135         zspeche_i,   & !Ice specific heat 
     136         z_i            !Vertical cotes of the layers in the ice 
     137 
     138      REAL(wp) , DIMENSION(jpij,0:nlay_s) :: & 
     139         zeta_s,      & !Eta factor in the snow 
     140         ztstemp,     & !Temporary temperature in the snow to check the convergence 
     141         ztsold,      & !Temporary temperature in the snow 
     142         z_s            !Vertical cotes of the layers in the snow 
     143 
     144      REAL(wp) , DIMENSION(jpij,jkmax+2) ::    & 
     145         zindterm,    & ! Independent term 
     146         zindtbis,    & ! temporary independent term 
     147         zdiagbis 
     148 
     149      REAL(wp) , DIMENSION(jpij,jkmax+2,3) ::  & 
     150         ztrid          ! tridiagonal system terms 
     151 
     152      REAL(wp), DIMENSION(jpij) ::  & 
     153         ztfs     ,   & ! ice melting point 
     154         ztsuold  ,   & ! old surface temperature (before the iterative 
     155                                !          procedure ) 
     156         ztsuoldit,   & ! surface temperature at previous iteration 
     157         zh_i     ,   & !ice layer thickness 
     158         zh_s     ,   & !snow layer thickness 
     159         zfsw     ,   & !solar radiation absorbed at the surface 
     160         zf       ,   & ! surface flux function 
     161         dzf            ! derivative of the surface flux function 
     162 
     163      REAL(wp)  ::           &  ! constant values 
     164         zeps      =  1.0e-10,   & ! 
     165         zg1s      =  2.0,       & !: for the tridiagonal system 
     166         zg1       =  2.0,       & 
     167         zgamma    =  18009.0,   & !: for specific heat 
     168         zbeta     =  0.117,     & !: for thermal conductivity (could be 0.13) 
     169         zraext_s  =  1.0e08,    & !: extinction coefficient of radiation in the snow 
     170         zkimin    =  0.10 ,     & !: minimum ice thermal conductivity 
     171         zht_smin  =  1.0e-4       !: minimum snow depth 
     172 
     173      REAL(wp)  ::          &  ! local variables  
     174         ztmelt_i,           &  ! ice melting temperature 
     175         zerritmax              ! current maximal error on temperature  
     176 
     177      REAL(wp), DIMENSION(jpij)  :: & 
     178         zerrit,             &  ! current error on temperature  
     179         zdifcase,           &  ! case of the equation resolution (1->4) 
     180         zftrice,            &  ! solar radiation transmitted through the ice 
     181         zihic, zhsu 
     182 
     183      ! 
     184      !------------------------------------------------------------------------------! 
     185      ! 1) Initialization                                                            ! 
     186      !------------------------------------------------------------------------------! 
     187      ! 
     188      DO ji = kideb , kiut 
     189         ! is there snow or not 
     190         isnow(ji)= INT ( 1.0 - MAX( 0.0 , SIGN (1.0, - ht_s_b(ji) ) ) ) 
     191         ! surface temperature of fusion 
     192         ztfs(ji) = isnow(ji) * rtt + (1.0-isnow(ji)) * rtt 
     193         ! layer thickness 
     194         zh_i(ji)              = ht_i_b(ji) / nlay_i 
     195         zh_s(ji)              = ht_s_b(ji) / nlay_s 
     196      END DO 
     197 
     198      !-------------------- 
     199      ! Ice / snow layers 
     200      !-------------------- 
     201 
     202      z_s(:,0)      = 0.0 ! vert. coord. of the up. lim. of the 1st snow layer 
     203      z_i(:,0)      = 0.0 ! vert. coord. of the up. lim. of the 1st ice layer 
     204 
     205      DO layer = 1, nlay_s 
     206         DO ji = kideb , kiut 
     207            ! vert. coord of the up. lim. of the layer-th snow layer 
     208            z_s(ji,layer)      = z_s(ji,layer-1) + ht_s_b(ji) / nlay_s 
     209         END DO 
     210      END DO 
     211 
     212      DO layer = 1, nlay_i 
     213         DO ji = kideb , kiut 
     214            ! vert. coord of the up. lim. of the layer-th ice layer 
     215            z_i(ji,layer)      = z_i(ji,layer-1) + ht_i_b(ji) / nlay_i 
     216         END DO 
     217      END DO 
     218      ! 
     219      !------------------------------------------------------------------------------| 
     220      ! 2) Radiations                                                                | 
     221      !------------------------------------------------------------------------------| 
     222      ! 
     223      !------------------- 
     224      ! Computation of i0 
     225      !------------------- 
     226      ! i0 describes the fraction of solar radiation which does not contribute 
     227      ! to the surface energy budget but rather penetrates inside the ice. 
     228      ! We assume that no radiation is transmitted through the snow 
     229      ! If there is no no snow 
     230      ! zfsw    = (1-i0).qsr_ice   is absorbed at the surface  
     231      ! zftrice = io.qsr_ice       is below the surface  
     232      ! fstbif  = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
     233 
     234      DO ji = kideb , kiut 
     235         ! switches 
     236         isnow(ji)  = INT ( 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s_b(ji) ) ) )  
     237         ! hs > 0, isnow = 1 
     238         zhsu(ji)   = hnzst  !threshold for the computation of i0 
     239         zihic(ji)  = MAX( zzero , 1.0 - ( ht_i_b(ji) / zhsu(ji) ) )      
     240 
     241         i0(ji)     = ( 1.0 - isnow(ji) ) * & 
     242            ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 
     243         !fr1_i0_1d = i0 for a thin ice surface 
     244         !fr1_i0_2d = i0 for a thick ice surface 
     245         !            a function of the cloud cover 
     246         ! 
     247         !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_b(ji)+10.0) 
     248         !formula used in Cice 
     249      END DO 
     250 
     251      !------------------------------------------------------- 
     252      ! Solar radiation absorbed / transmitted at the surface 
     253      ! Derivative of the non solar flux 
     254      !------------------------------------------------------- 
     255      DO ji = kideb , kiut 
     256 
     257         ! Shortwave radiation absorbed at surface 
     258         zfsw(ji)   =  qsr_ice_1d(ji) * ( 1 - i0(ji) ) 
     259 
     260         ! Solar radiation transmitted below the surface layer 
     261         zftrice(ji)=  qsr_ice_1d(ji) * i0(ji) 
     262 
     263         ! derivative of incoming nonsolar flux  
     264         dzf(ji)   =    dqns_ice_1d(ji)   
     265 
     266      END DO 
     267 
     268      !--------------------------------------------------------- 
     269      ! Transmission - absorption of solar radiation in the ice 
     270      !--------------------------------------------------------- 
     271 
     272      DO ji = kideb , kiut 
     273         ! Initialization 
     274         zradtr_s(ji,0) = zftrice(ji) ! radiation penetrating through snow 
     275      END DO 
     276 
     277      ! Radiation through snow 
     278      DO layer = 1, nlay_s 
     279         DO ji = kideb , kiut 
     280            ! radiation transmitted below the layer-th snow layer 
     281            zradtr_s(ji,layer) = zradtr_s(ji,0) * EXP ( - zraext_s * ( MAX ( 0.0 , & 
     282               z_s(ji,layer) ) ) ) 
     283            ! radiation absorbed by the layer-th snow layer 
     284            zradab_s(ji,layer) = zradtr_s(ji,layer-1) - zradtr_s(ji,layer) 
     285         END DO 
     286      END DO 
     287 
     288      ! Radiation through ice 
     289      DO ji = kideb , kiut 
     290         zradtr_i(ji,0)        = zradtr_s(ji,nlay_s) * isnow(ji) + &  
     291            zftrice(ji) * ( 1 - isnow(ji) ) 
     292      END DO 
     293 
     294      DO layer = 1, nlay_i 
     295         DO ji = kideb , kiut 
     296            ! radiation transmitted below the layer-th ice layer 
     297            zradtr_i(ji,layer) = zradtr_i(ji,0) * EXP ( - kappa_i * ( MAX ( 0.0 , & 
     298               z_i(ji,layer) ) ) ) 
     299            ! radiation absorbed by the layer-th ice layer 
     300            zradab_i(ji,layer) = zradtr_i(ji,layer-1) - zradtr_i(ji,layer) 
     301         END DO 
     302      END DO 
     303 
     304      ! Radiation transmitted below the ice 
     305      DO ji = kideb , kiut 
     306         fstbif_1d(ji)  =  fstbif_1d(ji) + & 
     307            zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) 
     308      END DO 
     309 
     310      ! +++++ 
     311      ! just to check energy conservation 
     312      DO ji = kideb , kiut 
     313         zji                 = MOD( npb(ji) - 1, jpi ) + 1 
     314         zjj                 = ( npb(ji) - 1 ) / jpi + 1 
     315         fstroc(zji,zjj,jl)  = & 
     316            zradtr_i(ji,nlay_i) 
     317      END DO 
     318      ! +++++ 
     319 
     320      DO layer = 1, nlay_i 
     321         DO ji = kideb , kiut 
     322            radab(ji,layer) = zradab_i(ji,layer) 
     323         END DO 
     324      END DO 
     325 
     326 
     327      ! 
     328      !------------------------------------------------------------------------------| 
     329      !  3) Iterative procedure begins                                               | 
     330      !------------------------------------------------------------------------------| 
     331      ! 
     332      ! Old surface temperature 
     333      DO ji = kideb, kiut 
     334         ztsuold(ji)          =  t_su_b(ji) ! temperature at the beg of iter pr. 
     335         ztsuoldit(ji)        =  t_su_b(ji) ! temperature at the previous iter 
     336         t_su_b(ji)           =  MIN(t_su_b(ji),ztfs(ji)-0.00001) !necessary 
     337         zerrit(ji)           =  1000.0     ! initial value of error 
     338      END DO 
     339      !RB Min global ?? 
     340 
     341      ! Old snow temperature 
     342      DO layer = 1, nlay_s 
     343         DO ji = kideb , kiut 
     344            ztsold(ji,layer)     =  t_s_b(ji,layer) 
     345         END DO 
     346      END DO 
     347 
     348      ! Old ice temperature 
     349      DO layer = 1, nlay_i 
     350         DO ji = kideb , kiut 
     351            ztiold(ji,layer)     =  t_i_b(ji,layer) 
     352         END DO 
     353      END DO 
     354 
     355      nconv     =  0         ! number of iterations 
     356      zerritmax =  1000.0    ! maximal value of error on all points 
     357 
     358      DO WHILE ((zerritmax > maxer_i_thd).AND.(nconv < nconv_i_thd)) 
     359 
     360         nconv   =  nconv+1 
     361 
     362         ! 
     363         !------------------------------------------------------------------------------| 
     364         ! 4) Sea ice thermal conductivity                                              | 
     365         !------------------------------------------------------------------------------| 
     366         ! 
     367         IF ( thcon_i_swi .EQ. 0 ) THEN 
     368            ! Untersteiner (1964) formula 
     369            DO ji = kideb , kiut 
     370               ztcond_i(ji,0)        = rcdic + zbeta*s_i_b(ji,1) / & 
     371                  MIN(-zeps,t_i_b(ji,1)-rtt) 
     372               ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin) 
     373            END DO 
     374         ENDIF 
     375 
     376         IF ( thcon_i_swi .EQ. 1 ) THEN 
     377            ! Pringle et al formula included, 
     378            ! 2.11 + 0.09 S/T - 0.011.T 
     379            DO ji = kideb , kiut 
     380               ztcond_i(ji,0)        = rcdic + 0.09*s_i_b(ji,1) / & 
     381                  MIN(-zeps,t_i_b(ji,1)-rtt) - & 
     382                  0.011* ( t_i_b(ji,1) - rtt )   
     383               ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin) 
     384            END DO 
     385         ENDIF 
     386 
     387         IF ( thcon_i_swi .EQ. 0 ) THEN ! Untersteiner 
     388            DO layer = 1, nlay_i-1 
     389               DO ji = kideb , kiut 
     390                  ztcond_i(ji,layer) = rcdic + zbeta*( s_i_b(ji,layer) & 
     391                     + s_i_b(ji,layer+1) ) / MIN(-zeps,     & 
     392                     t_i_b(ji,layer)+t_i_b(ji,layer+1)-2.0*rtt) 
     393                  ztcond_i(ji,layer)   = MAX(ztcond_i(ji,layer),zkimin) 
     394               END DO 
     395            END DO 
     396         ENDIF 
     397 
     398         IF ( thcon_i_swi .EQ. 1 ) THEN ! Pringle 
     399            DO layer = 1, nlay_i-1 
     400               DO ji = kideb , kiut 
     401                  ztcond_i(ji,layer) = rcdic + 0.09*( s_i_b(ji,layer)   & 
     402                     + s_i_b(ji,layer+1) ) / MIN(-zeps,      & 
     403                     t_i_b(ji,layer)+t_i_b(ji,layer+1)-2.0*rtt) - & 
     404                     0.011* ( t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2.0*rtt )   
     405                  ztcond_i(ji,layer) = MAX(ztcond_i(ji,layer),zkimin) 
     406               END DO 
     407            END DO 
     408         ENDIF 
     409 
     410         IF ( thcon_i_swi .EQ. 0 ) THEN ! Untersteiner 
     411            DO ji = kideb , kiut 
     412               ztcond_i(ji,nlay_i)   = rcdic + zbeta*s_i_b(ji,nlay_i) / & 
     413                  MIN(-zeps,t_bo_b(ji)-rtt) 
     414               ztcond_i(ji,nlay_i)   = MAX(ztcond_i(ji,nlay_i),zkimin) 
     415            END DO 
     416         ENDIF 
     417 
     418         IF ( thcon_i_swi .EQ. 1 ) THEN ! Pringle 
     419            DO ji = kideb , kiut 
     420               ztcond_i(ji,nlay_i)   = rcdic + 0.09*s_i_b(ji,nlay_i) / & 
     421                  MIN(-zeps,t_bo_b(ji)-rtt) - & 
     422                  0.011* ( t_bo_b(ji) - rtt )   
     423               ztcond_i(ji,nlay_i)   = MAX(ztcond_i(ji,nlay_i),zkimin) 
     424            END DO 
     425         ENDIF 
     426         ! 
     427         !------------------------------------------------------------------------------| 
     428         !  5) kappa factors                                                            | 
     429         !------------------------------------------------------------------------------| 
     430         ! 
     431         DO ji = kideb, kiut 
     432 
     433            !-- Snow kappa factors 
     434            zkappa_s(ji,0)         = rcdsn / MAX(zeps,zh_s(ji)) 
     435            zkappa_s(ji,nlay_s)    = rcdsn / MAX(zeps,zh_s(ji)) 
     436         END DO 
     437 
     438         DO layer = 1, nlay_s-1 
     439            DO ji = kideb , kiut 
     440               zkappa_s(ji,layer)  = 2.0 * rcdsn / & 
     441                  MAX(zeps,2.0*zh_s(ji)) 
     442            END DO 
     443         END DO 
     444 
     445         DO layer = 1, nlay_i-1 
     446            DO ji = kideb , kiut 
     447               !-- Ice kappa factors 
     448               zkappa_i(ji,layer)  = 2.0*ztcond_i(ji,layer)/ & 
     449                  MAX(zeps,2.0*zh_i(ji))  
     450            END DO 
     451         END DO 
     452 
     453         DO ji = kideb , kiut 
     454            zkappa_i(ji,0)        = ztcond_i(ji,0)/MAX(zeps,zh_i(ji)) 
     455            zkappa_i(ji,nlay_i)   = ztcond_i(ji,nlay_i) / MAX(zeps,zh_i(ji)) 
     456            !-- Interface 
     457            zkappa_s(ji,nlay_s)   = 2.0*rcdsn*ztcond_i(ji,0)/MAX(zeps, & 
     458               (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji))) 
     459            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s)*isnow(ji) & 
     460               + zkappa_i(ji,0)*(1.0-isnow(ji)) 
     461         END DO 
     462         ! 
     463         !------------------------------------------------------------------------------| 
     464         ! 6) Sea ice specific heat, eta factors                                        | 
     465         !------------------------------------------------------------------------------| 
     466         ! 
     467         DO layer = 1, nlay_i 
     468            DO ji = kideb , kiut 
     469               ztitemp(ji,layer)   = t_i_b(ji,layer) 
     470               zspeche_i(ji,layer) = cpic + zgamma*s_i_b(ji,layer)/ & 
     471                  MAX((t_i_b(ji,layer)-rtt)*(ztiold(ji,layer)-rtt),zeps) 
     472               zeta_i(ji,layer)    = rdt_ice / MAX(rhoic*zspeche_i(ji,layer)*zh_i(ji), & 
     473                  zeps) 
     474            END DO 
     475         END DO 
     476 
     477         DO layer = 1, nlay_s 
     478            DO ji = kideb , kiut 
     479               ztstemp(ji,layer) = t_s_b(ji,layer) 
     480               zeta_s(ji,layer)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),zeps) 
     481            END DO 
     482         END DO 
     483         ! 
     484         !------------------------------------------------------------------------------| 
     485         ! 7) surface flux computation                                                  | 
     486         !------------------------------------------------------------------------------| 
     487         ! 
     488         DO ji = kideb , kiut 
     489 
     490            ! update of the non solar flux according to the update in T_su 
     491            qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * &  
     492               ( t_su_b(ji) - ztsuoldit(ji) ) 
     493 
     494            ! update incoming flux 
     495            zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation 
     496               + qnsr_ice_1d(ji)           ! non solar total flux  
     497            ! (LWup, LWdw, SH, LH) 
     498 
     499         END DO 
     500 
     501         ! 
     502         !------------------------------------------------------------------------------| 
     503         ! 8) tridiagonal system terms                                                  | 
     504         !------------------------------------------------------------------------------| 
     505         ! 
     506         !!layer denotes the number of the layer in the snow or in the ice 
     507         !!numeq denotes the reference number of the equation in the tridiagonal 
     508         !!system, terms of tridiagonal system are indexed as following : 
     509         !!1 is subdiagonal term, 2 is diagonal and 3 is superdiagonal one 
     510 
     511         !!ice interior terms (top equation has the same form as the others) 
     512 
     513         DO numeq=1,jkmax+2 
     514            DO ji = kideb , kiut 
     515               ztrid(ji,numeq,1) = 0. 
     516               ztrid(ji,numeq,2) = 0. 
     517               ztrid(ji,numeq,3) = 0. 
     518               zindterm(ji,numeq)= 0. 
     519               zindtbis(ji,numeq)= 0. 
     520               zdiagbis(ji,numeq)= 0. 
     521            ENDDO 
     522         ENDDO 
     523 
     524         DO numeq = nlay_s + 2, nlay_s + nlay_i  
     525            DO ji = kideb , kiut 
     526               layer              = numeq - nlay_s - 1 
     527               ztrid(ji,numeq,1)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer-1) 
     528               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,layer)*(zkappa_i(ji,layer-1) + & 
     529                  zkappa_i(ji,layer)) 
     530               ztrid(ji,numeq,3)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer) 
     531               zindterm(ji,numeq) =  ztiold(ji,layer) + zeta_i(ji,layer)* & 
     532                  zradab_i(ji,layer) 
     533            END DO 
     534         ENDDO 
     535 
     536         numeq =  nlay_s + nlay_i + 1 
     537         DO ji = kideb , kiut 
    543538            !!ice bottom term 
    544539            ztrid(ji,numeq,1)  =  - zeta_i(ji,nlay_i)*zkappa_i(ji,nlay_i-1)    
    545540            ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,nlay_i)*( zkappa_i(ji,nlay_i)*zg1 & 
    546                                +  zkappa_i(ji,nlay_i-1) ) 
     541               +  zkappa_i(ji,nlay_i-1) ) 
    547542            ztrid(ji,numeq,3)  =  0.0 
    548543            zindterm(ji,numeq) =  ztiold(ji,nlay_i) + zeta_i(ji,nlay_i)* & 
    549                                  ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 & 
    550                               *  t_bo_b(ji) )  
    551           ENDDO 
    552  
    553  
    554           DO ji = kideb , kiut 
     544               ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 & 
     545               *  t_bo_b(ji) )  
     546         ENDDO 
     547 
     548 
     549         DO ji = kideb , kiut 
    555550            IF ( ht_s_b(ji).gt.0.0 ) THEN 
    556 ! 
    557 !------------------------------------------------------------------------------| 
    558 !  snow-covered cells                                                          | 
    559 !------------------------------------------------------------------------------| 
    560 ! 
    561                 !!snow interior terms (bottom equation has the same form as the others) 
    562                 DO numeq = 3, nlay_s + 1 
    563                    layer =  numeq - 1 
    564                    ztrid(ji,numeq,1)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer-1) 
    565                    ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,layer)*( zkappa_s(ji,layer-1) + & 
    566                                           zkappa_s(ji,layer) ) 
    567                    ztrid(ji,numeq,3)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer) 
    568                    zindterm(ji,numeq)  =  ztsold(ji,layer) + zeta_s(ji,layer)* & 
    569                                           zradab_s(ji,layer) 
    570                 END DO 
    571       
    572                 !!case of only one layer in the ice (ice equation is altered) 
    573                 IF ( nlay_i.eq.1 ) THEN 
    574                    ztrid(ji,nlay_s+2,3)    =  0.0 
    575                    zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1)* & 
    576                                            t_bo_b(ji)  
    577                 ENDIF 
    578  
    579                 IF ( t_su_b(ji) .LT. rtt ) THEN 
    580   
    581 !------------------------------------------------------------------------------| 
    582 !  case 1 : no surface melting - snow present                                  | 
    583 !------------------------------------------------------------------------------| 
    584                    zdifcase(ji)    =  1.0 
    585                    numeqmin(ji)    =  1 
    586                    numeqmax(ji)    =  nlay_i + nlay_s + 1 
    587  
    588                    !!surface equation 
    589                    ztrid(ji,1,1) = 0.0 
    590                    ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0) 
    591                    ztrid(ji,1,3) = zg1s*zkappa_s(ji,0) 
    592                    zindterm(ji,1) = dzf(ji)*t_su_b(ji)   - zf(ji) 
    593  
    594                    !!first layer of snow equation 
    595                    ztrid(ji,2,1)  =  - zkappa_s(ji,0)*zg1s*zeta_s(ji,1) 
    596                    ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1)*(zkappa_s(ji,1) + zkappa_s(ji,0)*zg1s) 
    597                    ztrid(ji,2,3)  =  - zeta_s(ji,1)* zkappa_s(ji,1) 
    598                    zindterm(ji,2) =  ztsold(ji,1) + zeta_s(ji,1)*zradab_s(ji,1) 
    599  
    600                 ELSE  
    601 ! 
    602 !------------------------------------------------------------------------------| 
    603 !  case 2 : surface is melting - snow present                                  | 
    604 !------------------------------------------------------------------------------| 
    605 ! 
    606                    zdifcase(ji)    =  2.0 
    607                    numeqmin(ji)    =  2 
    608                    numeqmax(ji)    =  nlay_i + nlay_s + 1 
    609  
    610                    !!first layer of snow equation 
    611                    ztrid(ji,2,1)  =  0.0 
    612                    ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + & 
    613                                            zkappa_s(ji,0) * zg1s ) 
    614                    ztrid(ji,2,3)  =  - zeta_s(ji,1)*zkappa_s(ji,1)  
    615                    zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) *            & 
    616                                   ( zradab_s(ji,1) +                         & 
    617                                     zkappa_s(ji,0) * zg1s * t_su_b(ji) )  
    618                 ENDIF 
    619              ELSE 
    620 ! 
    621 !------------------------------------------------------------------------------| 
    622 !  cells without snow                                                          | 
    623 !------------------------------------------------------------------------------| 
    624 ! 
    625                 IF (t_su_b(ji) .LT. rtt) THEN 
    626 ! 
    627 !------------------------------------------------------------------------------| 
    628 !  case 3 : no surface melting - no snow                                       | 
    629 !------------------------------------------------------------------------------| 
    630 ! 
    631                    zdifcase(ji)      =  3.0 
    632                    numeqmin(ji)      =  nlay_s + 1 
    633                    numeqmax(ji)      =  nlay_i + nlay_s + 1 
    634  
    635                    !!surface equation   
    636                    ztrid(ji,numeqmin(ji),1)   =  0.0 
    637                    ztrid(ji,numeqmin(ji),2)   =  dzf(ji) - zkappa_i(ji,0)*zg1     
    638                    ztrid(ji,numeqmin(ji),3)   =  zkappa_i(ji,0)*zg1 
    639                    zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_b(ji) - zf(ji) 
    640  
    641                    !!first layer of ice equation 
    642                    ztrid(ji,numeqmin(ji)+1,1) =  - zkappa_i(ji,0) * zg1 * zeta_i(ji,1) 
    643                    ztrid(ji,numeqmin(ji)+1,2) =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) &  
    644                                               + zkappa_i(ji,0) * zg1 ) 
    645                    ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1)*zkappa_i(ji,1)   
    646                    zindterm(ji,numeqmin(ji)+1)=  ztiold(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)   
    647  
    648                    !!case of only one layer in the ice (surface & ice equations are altered) 
    649  
    650                    IF (nlay_i.eq.1) THEN 
    651                       ztrid(ji,numeqmin(ji),1)    =  0.0 
    652                       ztrid(ji,numeqmin(ji),2)    =  dzf(ji) - zkappa_i(ji,0)*2.0 
    653                       ztrid(ji,numeqmin(ji),3)    =  zkappa_i(ji,0)*2.0 
    654                       ztrid(ji,numeqmin(ji)+1,1)  =  -zkappa_i(ji,0)*2.0*zeta_i(ji,1) 
    655                       ztrid(ji,numeqmin(ji)+1,2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + & 
    656                                               zkappa_i(ji,1)) 
    657                       ztrid(ji,numeqmin(ji)+1,3)  =  0.0 
    658  
    659                       zindterm(ji,numeqmin(ji)+1) =  ztiold(ji,1) + zeta_i(ji,1)* & 
    660                                       ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji) ) 
    661                    ENDIF      
    662  
    663                 ELSE 
    664   
    665 ! 
    666 !------------------------------------------------------------------------------| 
    667 ! case 4 : surface is melting - no snow                                        | 
    668 !------------------------------------------------------------------------------| 
    669 ! 
    670                    zdifcase(ji)    =  4.0 
    671                    numeqmin(ji)    =  nlay_s + 2 
    672                    numeqmax(ji)    =  nlay_i + nlay_s + 1 
    673  
    674                    !!first layer of ice equation 
    675                    ztrid(ji,numeqmin(ji),1)      =  0.0 
    676                    ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,1) + zkappa_i(ji,0)* & 
    677                                              zg1)   
    678                    ztrid(ji,numeqmin(ji),3)      =  - zeta_i(ji,1) * zkappa_i(ji,1) 
    679                    zindterm(ji,numeqmin(ji))     =  ztiold(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + & 
    680                                                     zkappa_i(ji,0) * zg1 * t_su_b(ji) )  
    681  
    682                    !!case of only one layer in the ice (surface & ice equations are altered) 
    683                    IF (nlay_i.eq.1) THEN 
    684                       ztrid(ji,numeqmin(ji),1)  =  0.0 
    685                       ztrid(ji,numeqmin(ji),2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + & 
    686                                          zkappa_i(ji,1)) 
    687                       ztrid(ji,numeqmin(ji),3)  =  0.0 
    688                       zindterm(ji,numeqmin(ji)) =  ztiold(ji,1) + zeta_i(ji,1)* & 
    689                                        (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji)) & 
    690                                       + t_su_b(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0 
    691                    ENDIF 
    692  
    693                 ENDIF 
    694              ENDIF 
    695   
    696           END DO 
    697  
    698 ! 
    699 !------------------------------------------------------------------------------| 
    700 ! 9) tridiagonal system solving                                                | 
    701 !------------------------------------------------------------------------------| 
    702 ! 
    703  
    704 ! Solve the tridiagonal system with Gauss elimination method. 
    705 ! Thomas algorithm, from Computational fluid Dynamics, J.D. ANDERSON,  
    706 ! McGraw-Hill 1984.   
    707  
    708           maxnumeqmax = 0 
    709           minnumeqmin = jkmax+4 
    710  
    711           DO ji = kideb , kiut 
    712              zindtbis(ji,numeqmin(ji)) =  zindterm(ji,numeqmin(ji)) 
    713              zdiagbis(ji,numeqmin(ji)) =  ztrid(ji,numeqmin(ji),2) 
    714              minnumeqmin               =  MIN(numeqmin(ji),minnumeqmin) 
    715              maxnumeqmax               =  MAX(numeqmax(ji),maxnumeqmax) 
    716           END DO 
    717  
    718           DO layer = minnumeqmin+1, maxnumeqmax 
    719              DO ji = kideb , kiut 
    720                 numeq               =  min(max(numeqmin(ji)+1,layer),numeqmax(ji)) 
    721                 zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* & 
    722                                        ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1) 
    723                 zindtbis(ji,numeq)  =  zindterm(ji,numeq) - ztrid(ji,numeq,1)* & 
    724                                        zindtbis(ji,numeq-1)/zdiagbis(ji,numeq-1) 
    725              END DO 
    726           END DO 
    727  
    728           DO ji = kideb , kiut 
    729           ! ice temperatures 
    730              t_i_b(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji)) 
    731           END DO 
    732  
    733           DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1 
    734              DO ji = kideb , kiut 
    735                 layer    =  numeq - nlay_s - 1 
    736                 t_i_b(ji,layer)  =  (zindtbis(ji,numeq) - ztrid(ji,numeq,3)* & 
    737                                        t_i_b(ji,layer+1))/zdiagbis(ji,numeq) 
    738              END DO 
    739           END DO 
    740  
    741           DO ji = kideb , kiut 
     551               ! 
     552               !------------------------------------------------------------------------------| 
     553               !  snow-covered cells                                                          | 
     554               !------------------------------------------------------------------------------| 
     555               ! 
     556               !!snow interior terms (bottom equation has the same form as the others) 
     557               DO numeq = 3, nlay_s + 1 
     558                  layer =  numeq - 1 
     559                  ztrid(ji,numeq,1)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer-1) 
     560                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,layer)*( zkappa_s(ji,layer-1) + & 
     561                     zkappa_s(ji,layer) ) 
     562                  ztrid(ji,numeq,3)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer) 
     563                  zindterm(ji,numeq)  =  ztsold(ji,layer) + zeta_s(ji,layer)* & 
     564                     zradab_s(ji,layer) 
     565               END DO 
     566 
     567               !!case of only one layer in the ice (ice equation is altered) 
     568               IF ( nlay_i.eq.1 ) THEN 
     569                  ztrid(ji,nlay_s+2,3)    =  0.0 
     570                  zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1)* & 
     571                     t_bo_b(ji)  
     572               ENDIF 
     573 
     574               IF ( t_su_b(ji) .LT. rtt ) THEN 
     575 
     576                  !------------------------------------------------------------------------------| 
     577                  !  case 1 : no surface melting - snow present                                  | 
     578                  !------------------------------------------------------------------------------| 
     579                  zdifcase(ji)    =  1.0 
     580                  numeqmin(ji)    =  1 
     581                  numeqmax(ji)    =  nlay_i + nlay_s + 1 
     582 
     583                  !!surface equation 
     584                  ztrid(ji,1,1) = 0.0 
     585                  ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0) 
     586                  ztrid(ji,1,3) = zg1s*zkappa_s(ji,0) 
     587                  zindterm(ji,1) = dzf(ji)*t_su_b(ji)   - zf(ji) 
     588 
     589                  !!first layer of snow equation 
     590                  ztrid(ji,2,1)  =  - zkappa_s(ji,0)*zg1s*zeta_s(ji,1) 
     591                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1)*(zkappa_s(ji,1) + zkappa_s(ji,0)*zg1s) 
     592                  ztrid(ji,2,3)  =  - zeta_s(ji,1)* zkappa_s(ji,1) 
     593                  zindterm(ji,2) =  ztsold(ji,1) + zeta_s(ji,1)*zradab_s(ji,1) 
     594 
     595               ELSE  
     596                  ! 
     597                  !------------------------------------------------------------------------------| 
     598                  !  case 2 : surface is melting - snow present                                  | 
     599                  !------------------------------------------------------------------------------| 
     600                  ! 
     601                  zdifcase(ji)    =  2.0 
     602                  numeqmin(ji)    =  2 
     603                  numeqmax(ji)    =  nlay_i + nlay_s + 1 
     604 
     605                  !!first layer of snow equation 
     606                  ztrid(ji,2,1)  =  0.0 
     607                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1) * ( zkappa_s(ji,1) + & 
     608                     zkappa_s(ji,0) * zg1s ) 
     609                  ztrid(ji,2,3)  =  - zeta_s(ji,1)*zkappa_s(ji,1)  
     610                  zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) *            & 
     611                     ( zradab_s(ji,1) +                         & 
     612                     zkappa_s(ji,0) * zg1s * t_su_b(ji) )  
     613               ENDIF 
     614            ELSE 
     615               ! 
     616               !------------------------------------------------------------------------------| 
     617               !  cells without snow                                                          | 
     618               !------------------------------------------------------------------------------| 
     619               ! 
     620               IF (t_su_b(ji) .LT. rtt) THEN 
     621                  ! 
     622                  !------------------------------------------------------------------------------| 
     623                  !  case 3 : no surface melting - no snow                                       | 
     624                  !------------------------------------------------------------------------------| 
     625                  ! 
     626                  zdifcase(ji)      =  3.0 
     627                  numeqmin(ji)      =  nlay_s + 1 
     628                  numeqmax(ji)      =  nlay_i + nlay_s + 1 
     629 
     630                  !!surface equation    
     631                  ztrid(ji,numeqmin(ji),1)   =  0.0 
     632                  ztrid(ji,numeqmin(ji),2)   =  dzf(ji) - zkappa_i(ji,0)*zg1     
     633                  ztrid(ji,numeqmin(ji),3)   =  zkappa_i(ji,0)*zg1 
     634                  zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_b(ji) - zf(ji) 
     635 
     636                  !!first layer of ice equation 
     637                  ztrid(ji,numeqmin(ji)+1,1) =  - zkappa_i(ji,0) * zg1 * zeta_i(ji,1) 
     638                  ztrid(ji,numeqmin(ji)+1,2) =  1.0 + zeta_i(ji,1) * ( zkappa_i(ji,1) &  
     639                     + zkappa_i(ji,0) * zg1 ) 
     640                  ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1)*zkappa_i(ji,1)   
     641                  zindterm(ji,numeqmin(ji)+1)=  ztiold(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)   
     642 
     643                  !!case of only one layer in the ice (surface & ice equations are altered) 
     644 
     645                  IF (nlay_i.eq.1) THEN 
     646                     ztrid(ji,numeqmin(ji),1)    =  0.0 
     647                     ztrid(ji,numeqmin(ji),2)    =  dzf(ji) - zkappa_i(ji,0)*2.0 
     648                     ztrid(ji,numeqmin(ji),3)    =  zkappa_i(ji,0)*2.0 
     649                     ztrid(ji,numeqmin(ji)+1,1)  =  -zkappa_i(ji,0)*2.0*zeta_i(ji,1) 
     650                     ztrid(ji,numeqmin(ji)+1,2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + & 
     651                        zkappa_i(ji,1)) 
     652                     ztrid(ji,numeqmin(ji)+1,3)  =  0.0 
     653 
     654                     zindterm(ji,numeqmin(ji)+1) =  ztiold(ji,1) + zeta_i(ji,1)* & 
     655                        ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji) ) 
     656                  ENDIF 
     657 
     658               ELSE 
     659 
     660                  ! 
     661                  !------------------------------------------------------------------------------| 
     662                  ! case 4 : surface is melting - no snow                                        | 
     663                  !------------------------------------------------------------------------------| 
     664                  ! 
     665                  zdifcase(ji)    =  4.0 
     666                  numeqmin(ji)    =  nlay_s + 2 
     667                  numeqmax(ji)    =  nlay_i + nlay_s + 1 
     668 
     669                  !!first layer of ice equation 
     670                  ztrid(ji,numeqmin(ji),1)      =  0.0 
     671                  ztrid(ji,numeqmin(ji),2)      =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,1) + zkappa_i(ji,0)* & 
     672                     zg1)   
     673                  ztrid(ji,numeqmin(ji),3)      =  - zeta_i(ji,1) * zkappa_i(ji,1) 
     674                  zindterm(ji,numeqmin(ji))     =  ztiold(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + & 
     675                     zkappa_i(ji,0) * zg1 * t_su_b(ji) )  
     676 
     677                  !!case of only one layer in the ice (surface & ice equations are altered) 
     678                  IF (nlay_i.eq.1) THEN 
     679                     ztrid(ji,numeqmin(ji),1)  =  0.0 
     680                     ztrid(ji,numeqmin(ji),2)  =  1.0 + zeta_i(ji,1)*(zkappa_i(ji,0)*2.0 + & 
     681                        zkappa_i(ji,1)) 
     682                     ztrid(ji,numeqmin(ji),3)  =  0.0 
     683                     zindterm(ji,numeqmin(ji)) =  ztiold(ji,1) + zeta_i(ji,1)* & 
     684                        (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji)) & 
     685                        + t_su_b(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0 
     686                  ENDIF 
     687 
     688               ENDIF 
     689            ENDIF 
     690 
     691         END DO 
     692 
     693         ! 
     694         !------------------------------------------------------------------------------| 
     695         ! 9) tridiagonal system solving                                                | 
     696         !------------------------------------------------------------------------------| 
     697         ! 
     698 
     699         ! Solve the tridiagonal system with Gauss elimination method. 
     700         ! Thomas algorithm, from Computational fluid Dynamics, J.D. ANDERSON,  
     701         ! McGraw-Hill 1984.   
     702 
     703         maxnumeqmax = 0 
     704         minnumeqmin = jkmax+4 
     705 
     706         DO ji = kideb , kiut 
     707            zindtbis(ji,numeqmin(ji)) =  zindterm(ji,numeqmin(ji)) 
     708            zdiagbis(ji,numeqmin(ji)) =  ztrid(ji,numeqmin(ji),2) 
     709            minnumeqmin               =  MIN(numeqmin(ji),minnumeqmin) 
     710            maxnumeqmax               =  MAX(numeqmax(ji),maxnumeqmax) 
     711         END DO 
     712 
     713         DO layer = minnumeqmin+1, maxnumeqmax 
     714            DO ji = kideb , kiut 
     715               numeq               =  min(max(numeqmin(ji)+1,layer),numeqmax(ji)) 
     716               zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* & 
     717                  ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1) 
     718               zindtbis(ji,numeq)  =  zindterm(ji,numeq) - ztrid(ji,numeq,1)* & 
     719                  zindtbis(ji,numeq-1)/zdiagbis(ji,numeq-1) 
     720            END DO 
     721         END DO 
     722 
     723         DO ji = kideb , kiut 
     724            ! ice temperatures 
     725            t_i_b(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji)) 
     726         END DO 
     727 
     728         DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1 
     729            DO ji = kideb , kiut 
     730               layer    =  numeq - nlay_s - 1 
     731               t_i_b(ji,layer)  =  (zindtbis(ji,numeq) - ztrid(ji,numeq,3)* & 
     732                  t_i_b(ji,layer+1))/zdiagbis(ji,numeq) 
     733            END DO 
     734         END DO 
     735 
     736         DO ji = kideb , kiut 
    742737            ! snow temperatures       
    743738            IF (ht_s_b(ji).GT.0) & 
    744             t_s_b(ji,nlay_s)     =  (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 
    745                                  *  t_i_b(ji,1))/zdiagbis(ji,nlay_s+1) & 
    746                                  *        MAX(0.0,SIGN(1.0,ht_s_b(ji)-zeps))  
     739               t_s_b(ji,nlay_s)     =  (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 
     740               *  t_i_b(ji,1))/zdiagbis(ji,nlay_s+1) & 
     741               *        MAX(0.0,SIGN(1.0,ht_s_b(ji)-zeps))  
    747742 
    748743            ! surface temperature 
    … …  
    750745            ztsuoldit(ji)        = t_su_b(ji) 
    751746            IF (t_su_b(ji) .LT. ztfs(ji)) & 
    752             t_su_b(ji)           = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* & 
    753                                    ( isnow(ji)*t_s_b(ji,1) + & 
    754                                    (1.0-isnow(ji))*t_i_b(ji,1) ) ) / & 
    755                                    zdiagbis(ji,numeqmin(ji))   
    756           END DO 
    757 ! 
    758 !-------------------------------------------------------------------------- 
    759 !  10) Has the scheme converged ?, end of the iterative procedure         | 
    760 !-------------------------------------------------------------------------- 
    761 ! 
    762           ! check that nowhere it has started to melt 
    763           ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd 
    764           DO ji = kideb , kiut 
    765              t_su_b(ji)          =  MAX(MIN(t_su_b(ji),ztfs(ji)),190.0) 
    766              zerrit(ji)          =  ABS(t_su_b(ji)-ztsuoldit(ji))      
    767           END DO 
    768  
    769           DO layer  =  1, nlay_s 
    770              DO ji = kideb , kiut 
    771                 zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    772                 zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    773                 t_s_b(ji,layer)  =  MAX(MIN(t_s_b(ji,layer),rtt),190.0) 
    774                 zerrit(ji)       =  MAX(zerrit(ji),ABS(t_s_b(ji,layer) & 
    775                                  -  ztstemp(ji,layer))) 
    776              END DO 
    777           END DO 
    778  
    779           DO layer  =  1, nlay_i 
    780              DO ji = kideb , kiut 
    781                 ztmelt_i         = -tmut*s_i_b(ji,layer) +rtt  
    782                 t_i_b(ji,layer)  =  MAX(MIN(t_i_b(ji,layer),ztmelt_i),190.0) 
    783                 zerrit(ji)       =  MAX(zerrit(ji),ABS(t_i_b(ji,layer) - ztitemp(ji,layer))) 
    784              END DO 
    785           END DO 
    786  
    787           ! Compute spatial maximum over all errors 
    788           ! note that this could be optimized substantially by iterating only 
    789           ! the non-converging points 
    790           zerritmax = 0.0 
    791           DO ji = kideb , kiut 
    792              zerritmax           =  MAX(zerritmax,zerrit(ji))    
    793           END DO 
    794           IF( lk_mpp ) CALL mpp_max(zerritmax, kcom=ncomm_ice) 
     747               t_su_b(ji)           = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* & 
     748               ( isnow(ji)*t_s_b(ji,1) + & 
     749               (1.0-isnow(ji))*t_i_b(ji,1) ) ) / & 
     750               zdiagbis(ji,numeqmin(ji))   
     751         END DO 
     752         ! 
     753         !-------------------------------------------------------------------------- 
     754         !  10) Has the scheme converged ?, end of the iterative procedure         | 
     755         !-------------------------------------------------------------------------- 
     756         ! 
     757         ! check that nowhere it has started to melt 
     758         ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd 
     759         DO ji = kideb , kiut 
     760            t_su_b(ji)          =  MAX(MIN(t_su_b(ji),ztfs(ji)),190.0) 
     761            zerrit(ji)          =  ABS(t_su_b(ji)-ztsuoldit(ji))      
     762         END DO 
     763 
     764         DO layer  =  1, nlay_s 
     765            DO ji = kideb , kiut 
     766               zji                 = MOD( npb(ji) - 1, jpi ) + 1 
     767               zjj                 = ( npb(ji) - 1 ) / jpi + 1 
     768               t_s_b(ji,layer)  =  MAX(MIN(t_s_b(ji,layer),rtt),190.0) 
     769               zerrit(ji)       =  MAX(zerrit(ji),ABS(t_s_b(ji,layer) & 
     770                  -  ztstemp(ji,layer))) 
     771            END DO 
     772         END DO 
     773 
     774         DO layer  =  1, nlay_i 
     775            DO ji = kideb , kiut 
     776               ztmelt_i         = -tmut*s_i_b(ji,layer) +rtt  
     777               t_i_b(ji,layer)  =  MAX(MIN(t_i_b(ji,layer),ztmelt_i),190.0) 
     778               zerrit(ji)       =  MAX(zerrit(ji),ABS(t_i_b(ji,layer) - ztitemp(ji,layer))) 
     779            END DO 
     780         END DO 
     781 
     782         ! Compute spatial maximum over all errors 
     783         ! note that this could be optimized substantially by iterating only 
     784         ! the non-converging points 
     785         zerritmax = 0.0 
     786         DO ji = kideb , kiut 
     787            zerritmax           =  MAX(zerritmax,zerrit(ji))    
     788         END DO 
     789         IF( lk_mpp ) CALL mpp_max(zerritmax, kcom=ncomm_ice) 
    795790 
    796791      END DO  ! End of the do while iterative procedure 
    … …  
    800795 
    801796 
    802 ! 
    803 !-------------------------------------------------------------------------- 
    804 !   11) Fluxes at the interfaces                                          | 
    805 !-------------------------------------------------------------------------- 
    806 ! 
    807        DO ji = kideb, kiut 
    808        ! update of latent heat fluxes 
    809           qla_ice_1d (ji) = qla_ice_1d (ji) + & 
    810                             dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) 
    811  
    812        ! surface ice conduction flux 
    813           isnow(ji)       = int(1.0-max(0.0,sign(1.0,-ht_s_b(ji)))) 
    814           fc_su(ji)       =  - isnow(ji)*zkappa_s(ji,0)*zg1s*(t_s_b(ji,1) - & 
    815                                t_su_b(ji)) & 
    816                              - (1.0-isnow(ji))*zkappa_i(ji,0)*zg1* & 
    817                                (t_i_b(ji,1) - t_su_b(ji)) 
    818  
    819        ! bottom ice conduction flux 
    820           fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i)* & 
    821                              ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
    822  
    823        END DO 
    824  
    825        !-------------------------! 
    826        ! Heat conservation       ! 
    827        !-------------------------! 
    828        IF ( con_i ) THEN 
    829  
    830        DO ji = kideb, kiut 
    831        ! Upper snow value 
    832           fc_s(ji,0) = - isnow(ji)* & 
    833                        zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - & 
    834                                t_su_b(ji) )  
    835        ! Bott. snow value 
    836           fc_s(ji,1) = - isnow(ji)* & 
    837                        zkappa_s(ji,1) * ( t_i_b(ji,1) - & 
    838                                t_s_b(ji,1) )  
    839        END DO 
    840  
    841        ! Upper ice layer 
    842        DO ji = kideb, kiut 
    843           fc_i(ji,0) = - isnow(ji) * &  ! interface flux if there is snow 
    844                        ( zkappa_i(ji,0)  * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 
    845                      - ( 1.0 - isnow(ji) ) * ( zkappa_i(ji,0) * &  
    846                      zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 
    847        END DO 
    848  
    849        ! Internal ice layers 
    850        DO layer = 1, nlay_i - 1 
    851        DO ji = kideb, kiut 
    852           fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - & 
    853                                                     t_i_b(ji,layer) ) 
    854           zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    855           zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    856        END DO 
    857        END DO 
    858  
    859        ! Bottom ice layers 
    860        DO ji = kideb, kiut 
    861           fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i)* & 
    862                              ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
    863        END DO 
    864  
    865        ENDIF 
    866  
    867     END SUBROUTINE lim_thd_dif 
     797      ! 
     798      !-------------------------------------------------------------------------- 
     799      !   11) Fluxes at the interfaces                                          | 
     800      !-------------------------------------------------------------------------- 
     801      ! 
     802      DO ji = kideb, kiut 
     803         ! update of latent heat fluxes 
     804         qla_ice_1d (ji) = qla_ice_1d (ji) + & 
     805            dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) 
     806 
     807         ! surface ice conduction flux 
     808         isnow(ji)       = int(1.0-max(0.0,sign(1.0,-ht_s_b(ji)))) 
     809         fc_su(ji)       =  - isnow(ji)*zkappa_s(ji,0)*zg1s*(t_s_b(ji,1) - & 
     810            t_su_b(ji)) & 
     811            - (1.0-isnow(ji))*zkappa_i(ji,0)*zg1* & 
     812            (t_i_b(ji,1) - t_su_b(ji)) 
     813 
     814         ! bottom ice conduction flux 
     815         fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i)* & 
     816            ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
     817 
     818      END DO 
     819 
     820      !-------------------------! 
     821      ! Heat conservation       ! 
     822      !-------------------------! 
     823      IF ( con_i ) THEN 
     824 
     825         DO ji = kideb, kiut 
     826            ! Upper snow value 
     827            fc_s(ji,0) = - isnow(ji)* & 
     828               zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - & 
     829               t_su_b(ji) )  
     830            ! Bott. snow value 
     831            fc_s(ji,1) = - isnow(ji)* & 
     832               zkappa_s(ji,1) * ( t_i_b(ji,1) - & 
     833               t_s_b(ji,1) )  
     834         END DO 
     835 
     836         ! Upper ice layer 
     837         DO ji = kideb, kiut 
     838            fc_i(ji,0) = - isnow(ji) * &  ! interface flux if there is snow 
     839               ( zkappa_i(ji,0)  * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 
     840               - ( 1.0 - isnow(ji) ) * ( zkappa_i(ji,0) * &  
     841               zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 
     842         END DO 
     843 
     844         ! Internal ice layers 
     845         DO layer = 1, nlay_i - 1 
     846            DO ji = kideb, kiut 
     847               fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - & 
     848                  t_i_b(ji,layer) ) 
     849               zji                 = MOD( npb(ji) - 1, jpi ) + 1 
     850               zjj                 = ( npb(ji) - 1 ) / jpi + 1 
     851            END DO 
     852         END DO 
     853 
     854         ! Bottom ice layers 
     855         DO ji = kideb, kiut 
     856            fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i)* & 
     857               ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
     858         END DO 
     859 
     860      ENDIF 
     861 
     862   END SUBROUTINE lim_thd_dif 
    868863 
    869864#else 
    … …  
    876871   END SUBROUTINE lim_thd_dif 
    877872#endif 
    878  END MODULE limthd_dif 
     873END MODULE limthd_dif 

  • trunk/NEMO/LIM_SRC_3/limthd_ent.F90

    r869 r921  
    4646CONTAINS 
    4747 
    48       SUBROUTINE lim_thd_ent(kideb,kiut,jl) 
     48   SUBROUTINE lim_thd_ent(kideb,kiut,jl) 
    4949      !!------------------------------------------------------------------- 
    5050      !!               ***   ROUTINE lim_thd_ent  *** 
    … …  
    135135      REAL(wp), DIMENSION(jpij,0:jkmax+3) :: & 
    136136         zhl0                  ! old and new layer thicknesses 
    137   
     137 
    138138      REAL(wp), DIMENSION(0:jkmax+3,0:jkmax+3) :: & 
    139139         zrl01 
    … …  
    144144         zqti_fin, zqts_fin 
    145145 
    146 !------------------------------------------------------------------------------| 
     146      !------------------------------------------------------------------------------| 
    147147 
    148148      zeps   = 1.0d-20 
    … …  
    156156      z_s(:,:)     = 0.0 
    157157 
    158 ! 
    159 !------------------------------------------------------------------------------| 
    160 !  1) Grid                                                                     | 
    161 !------------------------------------------------------------------------------| 
    162 ! 
     158      ! 
     159      !------------------------------------------------------------------------------| 
     160      !  1) Grid                                                                     | 
     161      !------------------------------------------------------------------------------| 
     162      ! 
    163163      nlays0        = nlay_s 
    164164      nlayi0        = nlay_i 
    … …  
    169169      ENDDO 
    170170 
    171 ! 
    172 !------------------------------------------------------------------------------| 
    173 !  2) Switches                                                                 | 
    174 !------------------------------------------------------------------------------| 
    175 ! 
     171      ! 
     172      !------------------------------------------------------------------------------| 
     173      !  2) Switches                                                                 | 
     174      !------------------------------------------------------------------------------| 
     175      ! 
    176176      ! 2.1 snind(ji), snswi(ji) 
    177177      ! snow surface behaviour : computation of snind(ji)-snswi(ji) 
    … …  
    181181      !   2 if 2nd layer is melting ... 
    182182      DO ji = kideb, kiut 
    183         snind(ji)     = 0 
    184         zdeltah(ji)   = 0.0 
     183         snind(ji)     = 0 
     184         zdeltah(ji)   = 0.0 
    185185      ENDDO !ji 
    186186 
    187187      DO jk = 1, nlays0 
    188         DO ji = kideb, kiut 
    189            snind(ji)  = jk        *      INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-zeps))) & 
    190                       + snind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-zeps)))) 
    191            zdeltah(ji)= zdeltah(ji) + zh_s(ji) 
    192         END DO ! ji 
     188         DO ji = kideb, kiut 
     189            snind(ji)  = jk        *      INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-zeps))) & 
     190               + snind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-zeps)))) 
     191            zdeltah(ji)= zdeltah(ji) + zh_s(ji) 
     192         END DO ! ji 
    193193      ENDDO ! jk 
    194194 
    … …  
    198198         snswi(ji)     = MAX(0,INT(-dh_s_tot(ji)/MAX(zeps,ABS(dh_s_tot(ji))))) 
    199199      ENDDO ! ji 
    200          
     200 
    201201      ! 2.2 icsuind(ji), icsuswi(ji) 
    202202      ! ice surface behaviour : computation of icsuind(ji)-icsuswi(ji) 
    … …  
    206206      !     2 if 2nd layer is reached by melt ... 
    207207      DO ji = kideb, kiut 
    208         icsuind(ji)   = 0 
    209         zdeltah(ji)   = 0.0 
     208         icsuind(ji)   = 0 
     209         zdeltah(ji)   = 0.0 
    210210      ENDDO !ji 
    211211      DO jk = 1, nlayi0 
    212         DO ji = kideb, kiut 
    213           icsuind(ji) = jk          *      INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-zeps))) & 
    214                       + icsuind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-zeps)))) 
    215           zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
    216         END DO ! ji 
     212         DO ji = kideb, kiut 
     213            icsuind(ji) = jk          *      INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-zeps))) & 
     214               + icsuind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-zeps)))) 
     215            zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
     216         END DO ! ji 
    217217      ENDDO !jk 
    218218 
    … …  
    232232      !            N+1 if all layers melt and that snow transforms into ice 
    233233      DO ji = kideb, kiut  
    234         icboind(ji)   = 0 
    235         zdeltah(ji)   = 0.0 
     234         icboind(ji)   = 0 
     235         zdeltah(ji)   = 0.0 
    236236      ENDDO 
    237237      DO jk = nlayi0, 1, -1 
    238         DO ji = kideb, kiut 
    239           icboind(ji) = (nlayi0+1-jk) & 
    240                       *      INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-zeps))) & 
    241                       + icboind(ji) & 
    242                       * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-zeps))))  
    243           zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
    244         END DO 
     238         DO ji = kideb, kiut 
     239            icboind(ji) = (nlayi0+1-jk) & 
     240               *      INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-zeps))) & 
     241               + icboind(ji) & 
     242               * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-zeps))))  
     243            zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
     244         END DO 
    245245      ENDDO 
    246246 
    … …  
    248248         ! case of total ablation with remaining snow 
    249249         IF ( ( ht_i_b(ji) .GT. zeps ) .AND. & 
    250               ( ht_i_b(ji) - dh_snowice(ji) .LT. zeps ) ) icboind(ji) = nlay_i + 1 
     250            ( ht_i_b(ji) - dh_snowice(ji) .LT. zeps ) ) icboind(ji) = nlay_i + 1 
    251251      END DO 
    252252 
    … …  
    265265      !     2 if penultiem layer ... 
    266266      DO ji = kideb, kiut 
    267         snicind(ji)   = 0 
    268         zdeltah(ji)   = 0.0 
     267         snicind(ji)   = 0 
     268         zdeltah(ji)   = 0.0 
    269269      ENDDO 
    270270      DO jk = nlays0, 1, -1 
    271         DO ji = kideb, kiut 
    272           snicind(ji) = (nlays0+1-jk) & 
    273                       *      INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-zeps))) & 
    274                       + snicind(ji) & 
    275                       * (1 - INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-zeps)))) 
    276           zdeltah(ji) = zdeltah(ji) + zh_s(ji) 
    277         END DO 
     271         DO ji = kideb, kiut 
     272            snicind(ji) = (nlays0+1-jk) & 
     273               *      INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-zeps))) & 
     274               + snicind(ji) & 
     275               * (1 - INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-zeps)))) 
     276            zdeltah(ji) = zdeltah(ji) + zh_s(ji) 
     277         END DO 
    278278      ENDDO 
    279279 
    … …  
    282282      !     0 if not 
    283283      DO ji = kideb, kiut 
    284         snicswi(ji)   = MAX(0,INT(dh_snowice(ji)/MAX(zeps,ABS(dh_snowice(ji))))) 
    285       ENDDO 
    286  
    287 ! 
    288 !------------------------------------------------------------------------------| 
    289 !  3) Snow redistribution                                                      | 
    290 !------------------------------------------------------------------------------| 
    291 ! 
     284         snicswi(ji)   = MAX(0,INT(dh_snowice(ji)/MAX(zeps,ABS(dh_snowice(ji))))) 
     285      ENDDO 
     286 
     287      ! 
     288      !------------------------------------------------------------------------------| 
     289      !  3) Snow redistribution                                                      | 
     290      !------------------------------------------------------------------------------| 
     291      ! 
    292292      !------------- 
    293293      ! Old profile 
    … …  
    303303 
    304304      DO ji = kideb, kiut 
    305         nbot0(ji)          =  nlays0  + 1 - snind(ji) + ( 1. - snicind(ji) ) * & 
    306                               snicswi(ji) 
    307         ! cotes of the top of the layers 
    308         zm0(ji,0)          =  0.0 
    309         maxnbot0           =  MAX ( maxnbot0 , nbot0(ji) ) 
    310       ENDDO  
     305         nbot0(ji)          =  nlays0  + 1 - snind(ji) + ( 1. - snicind(ji) ) * & 
     306            snicswi(ji) 
     307         ! cotes of the top of the layers 
     308         zm0(ji,0)          =  0.0 
     309         maxnbot0           =  MAX ( maxnbot0 , nbot0(ji) ) 
     310      ENDDO 
    311311      IF( lk_mpp ) CALL mpp_max( maxnbot0, kcom=ncomm_ice ) 
    312312 
    313313      DO jk = 1, maxnbot0 
    314         DO ji = kideb, kiut 
    315         !change 
    316            limsum      = ( 1 - snswi(ji) ) * ( jk - 1 ) +                      & 
    317                                snswi(ji) * ( jk + snind(ji) - 1 ) 
    318            limsum      = MIN( limsum , nlay_s ) 
    319            zm0(ji,jk)  =  dh_s_tot(ji) + zh_s(ji) * limsum 
    320         END DO 
     314         DO ji = kideb, kiut 
     315            !change 
     316            limsum      = ( 1 - snswi(ji) ) * ( jk - 1 ) +                      & 
     317               snswi(ji) * ( jk + snind(ji) - 1 ) 
     318            limsum      = MIN( limsum , nlay_s ) 
     319            zm0(ji,jk)  =  dh_s_tot(ji) + zh_s(ji) * limsum 
     320         END DO 
    321321      ENDDO 
    322322 
    323323      DO ji = kideb, kiut 
    324324         zm0(ji,nbot0(ji)) =  dh_s_tot(ji) - snicswi(ji) * dh_snowice(ji) + & 
    325                               zh_s(ji) * nlays0 
     325            zh_s(ji) * nlays0 
    326326         zm0(ji,1)         =  dh_s_tot(ji) * (1 -snswi(ji) ) +              & 
    327                               snswi(ji) * zm0(ji,1) 
     327            snswi(ji) * zm0(ji,1) 
    328328      ENDDO 
    329329 
    330330      DO jk = ntop0, maxnbot0 
    331         DO ji = kideb, kiut 
    332         ! layer thickness 
    333            zthick0(ji,jk)  =  zm0(ji,jk) - zm0(ji,jk-1) 
    334         END DO 
     331         DO ji = kideb, kiut 
     332            ! layer thickness 
     333            zthick0(ji,jk)  =  zm0(ji,jk) - zm0(ji,jk-1) 
     334         END DO 
    335335      ENDDO 
    336336 
    337337      zqts_in(:) = 0.0 
    338        
    339       DO ji = kideb, kiut 
    340         ! layer heat content 
    341         qm0(ji,1)   =  rhosn * ( cpic * ( rtt - ( 1. - snswi(ji) ) * ( tatm_ice_1d(ji) ) & 
    342                                             - snswi(ji) * t_s_b(ji,1) )         & 
    343                                + lfus ) * zthick0(ji,1) 
    344         zqts_in(ji) =  zqts_in(ji) + qm0(ji,1)  
     338 
     339      DO ji = kideb, kiut 
     340         ! layer heat content 
     341         qm0(ji,1)   =  rhosn * ( cpic * ( rtt - ( 1. - snswi(ji) ) * ( tatm_ice_1d(ji) ) & 
     342            - snswi(ji) * t_s_b(ji,1) )         & 
     343            + lfus ) * zthick0(ji,1) 
     344         zqts_in(ji) =  zqts_in(ji) + qm0(ji,1)  
    345345      ENDDO 
    346346 
    347347      DO jk = 2, maxnbot0 
    348         DO ji = kideb, kiut 
    349           limsum      = ( 1 - snswi(ji) ) * ( jk - 1 ) +                      & 
    350                                 snswi(ji) * ( jk + snind(ji) - 1 ) 
    351           limsum      = MIN( limsum , nlay_s ) 
    352           qm0(ji,jk)  = rhosn * ( cpic * ( rtt - t_s_b(ji,limsum) ) + lfus )  & 
    353                       * zthick0(ji,jk) 
    354           zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, zeps - ht_s_b(ji) ) ) 
    355           zqts_in(ji) = zqts_in(ji) + ( 1. - snswi(ji) ) * qm0(ji,jk) * zswitch 
    356         END DO ! jk 
     348         DO ji = kideb, kiut 
     349            limsum      = ( 1 - snswi(ji) ) * ( jk - 1 ) +                      & 
     350               snswi(ji) * ( jk + snind(ji) - 1 ) 
     351            limsum      = MIN( limsum , nlay_s ) 
     352            qm0(ji,jk)  = rhosn * ( cpic * ( rtt - t_s_b(ji,limsum) ) + lfus )  & 
     353               * zthick0(ji,jk) 
     354            zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, zeps - ht_s_b(ji) ) ) 
     355            zqts_in(ji) = zqts_in(ji) + ( 1. - snswi(ji) ) * qm0(ji,jk) * zswitch 
     356         END DO ! jk 
    357357      ENDDO ! ji 
    358358 
    … …  
    362362      ! zqsnow, enthalpy of the flooded snow 
    363363      DO ji = kideb, kiut 
    364         zqsnow(ji)     =  rhosn*lfus 
    365         zdeltah(ji)    =  0.0 
     364         zqsnow(ji)     =  rhosn*lfus 
     365         zdeltah(ji)    =  0.0 
    366366      ENDDO 
    367367 
    368368      DO jk =  nlays0, 1, -1 
    369         DO ji = kideb, kiut 
    370            zhsnow      =  MAX(0.0,dh_snowice(ji)-zdeltah(ji)) 
    371            zqsnow(ji)  =  zqsnow(ji) + & 
    372                           rhosn*cpic*(rtt-t_s_b(ji,jk)) 
    373            zdeltah(ji) =  zdeltah(ji) + zh_s(ji) 
    374         END DO 
     369         DO ji = kideb, kiut 
     370            zhsnow      =  MAX(0.0,dh_snowice(ji)-zdeltah(ji)) 
     371            zqsnow(ji)  =  zqsnow(ji) + & 
     372               rhosn*cpic*(rtt-t_s_b(ji,jk)) 
     373            zdeltah(ji) =  zdeltah(ji) + zh_s(ji) 
     374         END DO 
    375375      ENDDO 
    376376 
    … …  
    398398 
    399399      DO jk = 1, nlay_s 
    400         DO ji = kideb, kiut 
    401            z_s(ji,jk) =  zh_s(ji) * jk 
    402         END DO 
     400         DO ji = kideb, kiut 
     401            z_s(ji,jk) =  zh_s(ji) * jk 
     402         END DO 
    403403      ENDDO 
    404404 
    … …  
    407407      !----------------- 
    408408      DO layer0 = ntop0, maxnbot0 
    409         DO ji = kideb, kiut 
    410            zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) 
    411         END DO 
     409         DO ji = kideb, kiut 
     410            zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) 
     411         END DO 
    412412      ENDDO 
    413413 
    414414      DO layer1 = ntop1, nbot1 
    415         DO ji = kideb, kiut 
    416            q_s_b(ji,layer1)= 0.0 
    417         END DO 
     415         DO ji = kideb, kiut 
     416            q_s_b(ji,layer1)= 0.0 
     417         END DO 
    418418      ENDDO 
    419419 
    … …  
    422422      !---------------- 
    423423      DO layer0 = ntop0, maxnbot0 
    424         DO layer1 = ntop1, nbot1 
    425            DO ji = kideb, kiut 
    426               zrl01(layer1,layer0) = MAX(0.0,( MIN(zm0(ji,layer0),z_s(ji,layer1)) & 
    427               - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1)))/MAX(zhl0(ji,layer0),epsi10))  
    428               q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0) & 
    429                                    * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+zeps)) 
    430            END DO 
    431         END DO 
     424         DO layer1 = ntop1, nbot1 
     425            DO ji = kideb, kiut 
     426               zrl01(layer1,layer0) = MAX(0.0,( MIN(zm0(ji,layer0),z_s(ji,layer1)) & 
     427                  - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1)))/MAX(zhl0(ji,layer0),epsi10))  
     428               q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0) & 
     429                  * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+zeps)) 
     430            END DO 
     431         END DO 
    432432      ENDDO 
    433433 
    … …  
    441441 
    442442      IF ( con_i ) THEN 
    443       DO ji = kideb, kiut 
    444          IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) / rdt_ice .GT. 1.0e-6 ) THEN 
    445             zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    446             zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    447             WRITE(numout,*) ' violation of heat conservation : ',             & 
    448                             ABS ( zqts_in(ji) - zqts_fin(ji) ) / rdt_ice 
    449             WRITE(numout,*) ' ji, jj   : ', zji, zjj 
    450             WRITE(numout,*) ' ht_s_b   : ', ht_s_b(ji) 
    451             WRITE(numout,*) ' zqts_in  : ', zqts_in(ji) / rdt_ice 
    452             WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) / rdt_ice 
    453             WRITE(numout,*) ' dh_snowice : ', dh_snowice(ji) 
    454             WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) 
    455             WRITE(numout,*) ' snswi    : ', snswi(ji) 
    456          ENDIF 
    457       END DO 
     443         DO ji = kideb, kiut 
     444            IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) / rdt_ice .GT. 1.0e-6 ) THEN 
     445               zji                 = MOD( npb(ji) - 1, jpi ) + 1 
     446               zjj                 = ( npb(ji) - 1 ) / jpi + 1 
     447               WRITE(numout,*) ' violation of heat conservation : ',             & 
     448                  ABS ( zqts_in(ji) - zqts_fin(ji) ) / rdt_ice 
     449               WRITE(numout,*) ' ji, jj   : ', zji, zjj 
     450               WRITE(numout,*) ' ht_s_b   : ', ht_s_b(ji) 
     451               WRITE(numout,*) ' zqts_in  : ', zqts_in(ji) / rdt_ice 
     452               WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) / rdt_ice 
     453               WRITE(numout,*) ' dh_snowice : ', dh_snowice(ji) 
     454               WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) 
     455               WRITE(numout,*) ' snswi    : ', snswi(ji) 
     456            ENDIF 
     457         END DO 
    458458      ENDIF 
    459459 
    … …  
    473473      zfac2 = lfus / cpic   
    474474      DO jk = 1, nlay_s 
    475         DO ji = kideb, kiut 
    476            zswitch = MAX ( 0.0 , SIGN ( 1.0, zeps - ht_s_b(ji) ) ) 
    477            t_s_b(ji,jk) = rtt                                                  & 
    478                         + ( 1.0 - zswitch ) *                                  & 
    479                           ( - zfac1 * q_s_b(ji,jk) + zfac2 ) 
    480         END DO 
    481       ENDDO 
    482 ! 
    483 !------------------------------------------------------------------------------| 
    484 !  4) Ice redistribution                                                       | 
    485 !------------------------------------------------------------------------------| 
    486 ! 
     475         DO ji = kideb, kiut 
     476            zswitch = MAX ( 0.0 , SIGN ( 1.0, zeps - ht_s_b(ji) ) ) 
     477            t_s_b(ji,jk) = rtt                                                  & 
     478               + ( 1.0 - zswitch ) *                                  & 
     479               ( - zfac1 * q_s_b(ji,jk) + zfac2 ) 
     480         END DO 
     481      ENDDO 
     482      ! 
     483      !------------------------------------------------------------------------------| 
     484      !  4) Ice redistribution                                                       | 
     485      !------------------------------------------------------------------------------| 
     486      ! 
    487487      !------------- 
    488488      ! OLD PROFILE  
    … …  
    496496 
    497497      DO ji = kideb, kiut 
    498         ! reference number of the bottommost layer 
     498         ! reference number of the bottommost layer 
    499499         nbot0(ji)    =  MAX( 1 ,  MIN( nlayi0 + ( 1 - icboind(ji) ) +        & 
    500                          ( 1 - icsuind(ji) ) * icsuswi(ji) + snicswi(ji) ,    & 
    501                          nlay_i + 2 ) ) 
     500            ( 1 - icsuind(ji) ) * icsuswi(ji) + snicswi(ji) ,    & 
     501            nlay_i + 2 ) ) 
    502502         ! maximum reference number of the bottommost layer over all domain 
    503503         maxnbot0     =  MAX( maxnbot0 , nbot0(ji) ) 
    … …  
    508508      !------------------------- 
    509509      zm0(:,0)    =  0.0 
    510        
     510 
    511511      DO jk = 1, maxnbot0 
    512512         DO ji = kideb, kiut 
    … …  
    515515            ! limsum is the real ice layer number corresponding to present jk 
    516516            limsum    =  ( (icsuswi(ji)*(icsuind(ji)+jk-1) + &  
    517                            (1-icsuswi(ji))*jk))*(1-snicswi(ji)) + (jk-1)*snicswi(ji) 
     517               (1-icsuswi(ji))*jk))*(1-snicswi(ji)) + (jk-1)*snicswi(ji) 
    518518            zm0(ji,jk)=  icsuswi(ji)*dh_i_surf(ji) + snicswi(ji)*dh_snowice(ji) & 
    519                       +  limsum * zh_i(ji) 
     519               +  limsum * zh_i(ji) 
    520520         END DO 
    521521      ENDDO 
    … …  
    523523      DO ji = kideb, kiut 
    524524         zm0(ji,nbot0(ji)) =  icsuswi(ji)*dh_i_surf(ji) + snicswi(ji)*dh_snowice(ji) + dh_i_bott(ji) & 
    525                            +  zh_i(ji) * nlayi0 
     525            +  zh_i(ji) * nlayi0 
    526526         zm0(ji,1)         =  snicswi(ji)*dh_snowice(ji) + (1-snicswi(ji))*zm0(ji,1) 
    527527      ENDDO 
    … …  
    531531      !----------------------------- 
    532532      DO jk = ntop0, maxnbot0 
    533         DO ji = kideb, kiut 
    534            zthick0(ji,jk) =  zm0(ji,jk) - zm0(ji,jk-1) 
    535         END DO 
     533         DO ji = kideb, kiut 
     534            zthick0(ji,jk) =  zm0(ji,jk) - zm0(ji,jk-1) 
     535         END DO 
    536536      ENDDO 
    537537 
    … …  
    545545         DO ji = kideb, kiut 
    546546            limsum =  MAX(1,MIN(snicswi(ji)*(jk-1) + icsuswi(ji)*(jk-1+icsuind(ji)) + & 
    547                                 (1-icsuswi(ji))*(1-snicswi(ji))*jk,nlay_i)) 
     547               (1-icsuswi(ji))*(1-snicswi(ji))*jk,nlay_i)) 
    548548            ztmelts = -tmut * s_i_b(ji,limsum) + rtt 
    549549            qm0(ji,jk) = rhoic * ( cpic * (ztmelts-t_i_b(ji,limsum)) + lfus * ( 1.0-(ztmelts-rtt)/ & 
    550                       MIN((t_i_b(ji,limsum)-rtt),-zeps) ) - rcp*(ztmelts-rtt) ) & 
    551                       * zthick0(ji,jk) 
     550               MIN((t_i_b(ji,limsum)-rtt),-zeps) ) - rcp*(ztmelts-rtt) ) & 
     551               * zthick0(ji,jk) 
    552552         END DO 
    553553      ENDDO 
    … …  
    557557      !---------------------------- 
    558558      DO ji = kideb, kiut         
    559         ztmelts    = ( 1.0 - icboswi(ji) ) * (-tmut * s_i_b(ji,nlayi0)) &   ! case of melting ice 
    560                    +      icboswi(ji)      * (-tmut * s_i_new(ji))      &   ! case of forming ice 
    561                    + rtt                        ! this temperature is in Celsius 
    562  
    563         ! bottom formation temperature 
    564         ztform = t_i_b(ji,nlay_i) 
    565         IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) ztform = t_bo_b(ji) 
    566         qm0(ji,nbot0(ji)) = ( 1.0 - icboswi(ji) )*qm0(ji,nbot0(ji)) &   ! case of melting ice 
    567                    + icboswi(ji) *                                  &   ! case of forming ice 
    568                      rhoic*( cpic*(ztmelts-ztform)                  & 
    569                            + lfus *( 1.0-(ztmelts-rtt)/             & 
    570                              MIN ( (ztform-rtt) , - epsi10 ) )      &  
    571                            - rcp*(ztmelts-rtt) )                    & 
    572                     *zthick0(ji,nbot0(ji)) 
     559         ztmelts    = ( 1.0 - icboswi(ji) ) * (-tmut * s_i_b(ji,nlayi0)) &   ! case of melting ice 
     560            +      icboswi(ji)      * (-tmut * s_i_new(ji))      &   ! case of forming ice 
     561            + rtt                        ! this temperature is in Celsius 
     562 
     563         ! bottom formation temperature 
     564         ztform = t_i_b(ji,nlay_i) 
     565         IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) ztform = t_bo_b(ji) 
     566         qm0(ji,nbot0(ji)) = ( 1.0 - icboswi(ji) )*qm0(ji,nbot0(ji)) &   ! case of melting ice 
     567            + icboswi(ji) *                                  &   ! case of forming ice 
     568            rhoic*( cpic*(ztmelts-ztform)                  & 
     569            + lfus *( 1.0-(ztmelts-rtt)/             & 
     570            MIN ( (ztform-rtt) , - epsi10 ) )      &  
     571            - rcp*(ztmelts-rtt) )                    & 
     572            *zthick0(ji,nbot0(ji)) 
    573573      ENDDO 
    574574 
    … …  
    579579         ! energy of the flooding seawater 
    580580         zqsnic = rau0 * rcp * ( rtt - t_bo_b(ji) ) * dh_snowice(ji) * & 
    581                   (rhoic - rhosn) / rhoic * snicswi(ji) ! generally positive 
     581            (rhoic - rhosn) / rhoic * snicswi(ji) ! generally positive 
    582582         ! Heat conservation diagnostic 
    583583         qt_i_in(ji,jl) = qt_i_in(ji,jl) + zqsnic  
    … …  
    593593 
    594594      DO jk = ntop0, maxnbot0 
    595         DO ji = kideb, kiut 
    596            ! Heat conservation 
    597            zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) & 
    598                        * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-zeps6+zeps) ) & 
    599                        * MAX( 0.0 , SIGN( 1. , nbot0(ji) - jk + zeps ) ) 
    600         END DO 
     595         DO ji = kideb, kiut 
     596            ! Heat conservation 
     597            zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) & 
     598               * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-zeps6+zeps) ) & 
     599               * MAX( 0.0 , SIGN( 1. , nbot0(ji) - jk + zeps ) ) 
     600         END DO 
    601601      ENDDO 
    602602 
    … …  
    616616      !------------------ 
    617617      DO ji = kideb, kiut 
    618         zh_i(ji)      = ht_i_b(ji) / nlay_i 
     618         zh_i(ji)      = ht_i_b(ji) / nlay_i 
    619619      ENDDO 
    620620 
    … …  
    624624      z_i(:,0) =  0.0 
    625625      DO jk = 1, nlay_i 
    626         DO ji = kideb, kiut 
    627            z_i(ji,jk) =  zh_i(ji) * jk 
    628         END DO 
     626         DO ji = kideb, kiut 
     627            z_i(ji,jk) =  zh_i(ji) * jk 
     628         END DO 
    629629      ENDDO 
    630630 
    631631      !--thicknesses of the layers 
    632632      DO layer0 = ntop0, maxnbot0 
    633         DO ji = kideb, kiut 
    634            zhl0(ji,layer0)   =  zm0(ji,layer0) - zm0(ji,layer0-1) !thicknesses of the layers 
    635         END DO 
     633         DO ji = kideb, kiut 
     634            zhl0(ji,layer0)   =  zm0(ji,layer0) - zm0(ji,layer0-1) !thicknesses of the layers 
     635         END DO 
    636636      ENDDO 
    637637 
    … …  
    642642      q_i_b(:,:) = 0.0 
    643643      DO layer0 = ntop0, maxnbot0 
    644         DO layer1 = ntop1, nbot1 
    645            DO ji = kideb, kiut 
    646               zrl01(layer1,layer0) = MAX(0.0,( MIN(zm0(ji,layer0),z_i(ji,layer1)) & 
    647               - MAX(zm0(ji,layer0-1), z_i(ji,layer1-1)))/MAX(zhl0(ji,layer0),epsi10)) 
    648               q_i_b(ji,layer1) = q_i_b(ji,layer1) &  
    649                                + zrl01(layer1,layer0)*qm0(ji,layer0) & 
    650                                * MAX(0.0,SIGN(1.0,ht_i_b(ji)-zeps6+zeps)) & 
    651                                * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+zeps)) 
    652            END DO 
    653         END DO 
     644         DO layer1 = ntop1, nbot1 
     645            DO ji = kideb, kiut 
     646               zrl01(layer1,layer0) = MAX(0.0,( MIN(zm0(ji,layer0),z_i(ji,layer1)) & 
     647                  - MAX(zm0(ji,layer0-1), z_i(ji,layer1-1)))/MAX(zhl0(ji,layer0),epsi10)) 
     648               q_i_b(ji,layer1) = q_i_b(ji,layer1) &  
     649                  + zrl01(layer1,layer0)*qm0(ji,layer0) & 
     650                  * MAX(0.0,SIGN(1.0,ht_i_b(ji)-zeps6+zeps)) & 
     651                  * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+zeps)) 
     652            END DO 
     653         END DO 
    654654      ENDDO 
    655655 
    … …  
    663663         END DO 
    664664      END DO 
    665 ! 
     665      ! 
    666666      DO ji = kideb, kiut 
    667667         IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) / rdt_ice .GT. 1.0e-6 ) THEN 
    … …  
    669669            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    670670            WRITE(numout,*) ' violation of heat conservation : ',             & 
    671                             ABS ( zqti_in(ji) - zqti_fin(ji) ) / rdt_ice 
     671               ABS ( zqti_in(ji) - zqti_fin(ji) ) / rdt_ice 
    672672            WRITE(numout,*) ' ji, jj   : ', zji, zjj 
    673673            WRITE(numout,*) ' ht_i_b   : ', ht_i_b(ji) 
    … …  
    700700      END DO 
    701701 
    702 ! 
    703 !------------------------------------------------------------------------------| 
    704 !  5) Update salinity and recover temperature                                  | 
    705 !------------------------------------------------------------------------------| 
    706 ! 
     702      ! 
     703      !------------------------------------------------------------------------------| 
     704      !  5) Update salinity and recover temperature                                  | 
     705      !------------------------------------------------------------------------------| 
     706      ! 
    707707      ! Update salinity (basal entrapment, snow ice formation) 
    708708      DO ji = kideb, kiut 
    709709         sm_i_b(ji) = sm_i_b(ji)                                & 
    710                     + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 
     710            + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 
    711711      END DO !ji 
    712712 
    … …  
    720720            zaaa         =  cpic 
    721721            zbbb         =  ( rcp - cpic ) * ( ztmelts - rtt ) + & 
    722                             q_i_b(ji,jk) / rhoic - lfus 
     722               q_i_b(ji,jk) / rhoic - lfus 
    723723            zccc         =  lfus * ( ztmelts - rtt ) 
    724724            zdiscrim     =  SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) ) 
    725725            t_i_b(ji,jk) =  rtt - ( zbbb + zdiscrim ) / &  
    726                                   ( 2.0 *zaaa ) 
     726               ( 2.0 *zaaa ) 
    727727         END DO !ji 
    728728 
    729729      END DO !jk 
    730730 
    731       END SUBROUTINE lim_thd_ent 
     731   END SUBROUTINE lim_thd_ent 
    732732 
    733733#else 
    … …  
    740740   END SUBROUTINE lim_thd_ent 
    741741#endif 
    742  END MODULE limthd_ent 
     742END MODULE limthd_ent 

  • trunk/NEMO/LIM_SRC_3/limthd_lac.F90

    r888 r921  
    2525   USE limtab 
    2626   USE limcons 
    27       
     27 
    2828   IMPLICIT NONE 
    2929   PRIVATE 
    … …  
    5050 
    5151CONTAINS 
    52      
     52 
    5353   SUBROUTINE lim_thd_lac 
    5454      !!------------------------------------------------------------------- 
    … …  
    146146         zalphai         ,   &  !: factor describing how old and new layers overlap each other [m] 
    147147         zindb             
    148           
     148 
    149149      REAL(wp), DIMENSION(jpij,jkmax+1,jpl) :: & 
    150150         zqm0            ,   &  !: old layer-system heat content 
    … …  
    188188 
    189189      !!-----------------------------------------------------------------------! 
    190            
     190 
    191191      et_i_init(:,:) = 0.0 
    192192      et_s_init(:,:) = 0.0 
    … …  
    195195      zeps6   = 1.0e-6 
    196196 
    197 !------------------------------------------------------------------------------! 
    198 ! 1) Conservation check and changes in each ice category 
    199 !------------------------------------------------------------------------------! 
     197      !------------------------------------------------------------------------------! 
     198      ! 1) Conservation check and changes in each ice category 
     199      !------------------------------------------------------------------------------! 
    200200      IF ( con_i ) THEN 
    201201         CALL lim_column_sum (jpl, v_i, vt_i_init) 
    … …  
    205205      ENDIF 
    206206 
    207 !------------------------------------------------------------------------------| 
    208 ! 2) Convert units for ice internal energy 
    209 !------------------------------------------------------------------------------| 
     207      !------------------------------------------------------------------------------| 
     208      ! 2) Convert units for ice internal energy 
     209      !------------------------------------------------------------------------------| 
    210210      DO jl = 1, jpl 
    211         DO jk = 1, nlay_i 
    212           DO jj = 1, jpj 
    213             DO ji = 1, jpi 
    214                !Energy of melting q(S,T) [J.m-3] 
    215                e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / & 
    216                             MAX( area(ji,jj) * v_i(ji,jj,jl) ,  zeps ) * & 
    217                             nlay_i 
    218                zindb      = 1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) !0 if no ice and 1 if yes 
    219                e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl)*unit_fac*zindb 
     211         DO jk = 1, nlay_i 
     212            DO jj = 1, jpj 
     213               DO ji = 1, jpi 
     214                  !Energy of melting q(S,T) [J.m-3] 
     215                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / & 
     216                     MAX( area(ji,jj) * v_i(ji,jj,jl) ,  zeps ) * & 
     217                     nlay_i 
     218                  zindb      = 1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) !0 if no ice and 1 if yes 
     219                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl)*unit_fac*zindb 
     220               END DO 
    220221            END DO 
    221           END DO 
    222         END DO 
     222         END DO 
    223223      END DO 
    224224 
    225 !------------------------------------------------------------------------------! 
    226 ! 3) Collection thickness of ice formed in leads and polynyas 
    227 !------------------------------------------------------------------------------!     
     225      !------------------------------------------------------------------------------! 
     226      ! 3) Collection thickness of ice formed in leads and polynyas 
     227      !------------------------------------------------------------------------------!     
    228228      ! hicol is the thickness of new ice formed in open water 
    229229      ! hicol can be either prescribed (frazswi = 0) 
    … …  
    248248      IF (fraz_swi.eq.1.0) THEN 
    249249 
    250           !-------------------- 
    251           ! Physical constants 
    252           !-------------------- 
    253           hicol(:,:) = 0.0 
    254  
    255           zhicrit = 0.04 ! frazil ice thickness 
    256           ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav 
    257           zsqcd   = 1.0 / SQRT( 1.3 * cai ) ! 1/SQRT(airdensity*drag) 
    258           zgamafr = 0.03 
    259  
    260           DO jj = 1, jpj 
    261           DO ji = 1, jpi 
    262  
    263           IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN 
    264             !------------- 
    265             ! Wind stress 
    266             !------------- 
    267             ! C-grid wind stress components 
    268             ztaux         = ( utaui_ice(ji-1,jj  ) * tmu(ji-1,jj  ) & 
    269                           +   utaui_ice(ji  ,jj  ) * tmu(ji  ,jj  ) ) / 2.0 
    270             ztauy         = ( vtaui_ice(ji  ,jj-1) * tmv(ji  ,jj-1) & 
    271                           +   vtaui_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) / 2.0 
    272             ! Square root of wind stress 
    273             ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
    274  
    275             !--------------------- 
    276             ! Frazil ice velocity 
    277             !--------------------- 
    278             zvfrx         = zgamafr * zsqcd * ztaux / MAX(ztenagm,zeps) 
    279             zvfry         = zgamafr * zsqcd * ztauy / MAX(ztenagm,zeps) 
    280  
    281             !------------------- 
    282             ! Pack ice velocity 
    283             !------------------- 
    284             ! C-grid ice velocity 
    285             zindb = MAX(0.0, SIGN(1.0, at_i(ji,jj) )) 
    286             zvgx  = zindb * ( u_ice(ji-1,jj  ) * tmu(ji-1,jj  ) & 
    287                             + u_ice(ji,jj    ) * tmu(ji  ,jj  ) ) / 2.0 
    288             zvgy  = zindb * ( v_ice(ji  ,jj-1) * tmv(ji  ,jj-1) & 
    289                             + v_ice(ji,jj    ) * tmv(ji  ,jj  ) ) / 2.0 
    290  
    291             !----------------------------------- 
    292             ! Relative frazil/pack ice velocity 
    293             !----------------------------------- 
    294             ! absolute relative velocity 
    295             zvrel2        = MAX( ( zvfrx - zvgx ) * ( zvfrx - zvgx ) + & 
    296                                  ( zvfry - zvgy ) * ( zvfry - zvgy )   & 
    297                                , 0.15 * 0.15 ) 
    298             zvrel(ji,jj)  = SQRT(zvrel2) 
    299  
    300             !--------------------- 
    301             ! Iterative procedure 
    302             !--------------------- 
    303             hicol(ji,jj) = zhicrit + 0.1  
    304             hicol(ji,jj) = zhicrit + hicol(ji,jj) /      &  
    305                          ( hicol(ji,jj) * hicol(ji,jj) - & 
    306                            zhicrit * zhicrit ) * ztwogp * zvrel2 
    307  
    308             iter = 1 
    309             iterate_frazil = .true. 
    310  
    311             DO WHILE ( iter .LT. 100 .AND. iterate_frazil )  
    312                zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) & 
    313                                  - hicol(ji,jj) * zhicrit * ztwogp * zvrel2 
    314                zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0*hicol(ji,jj) + zhicrit ) & 
    315                                  - zhicrit * ztwogp * zvrel2 
    316                zhicol_new = hicol(ji,jj) - zf/zfp 
    317                hicol(ji,jj)   = zhicol_new 
    318  
    319                iter = iter + 1 
    320  
    321             END DO ! do while 
    322  
    323           ENDIF ! end of selection of pixels where ice forms 
    324  
    325       END DO ! loop on ji ends 
    326       END DO ! loop on jj ends 
     250         !-------------------- 
     251         ! Physical constants 
     252         !-------------------- 
     253         hicol(:,:) = 0.0 
     254 
     255         zhicrit = 0.04 ! frazil ice thickness 
     256         ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav 
     257         zsqcd   = 1.0 / SQRT( 1.3 * cai ) ! 1/SQRT(airdensity*drag) 
     258         zgamafr = 0.03 
     259 
     260         DO jj = 1, jpj 
     261            DO ji = 1, jpi 
     262 
     263               IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN 
     264                  !------------- 
     265                  ! Wind stress 
     266                  !------------- 
     267                  ! C-grid wind stress components 
     268                  ztaux         = ( utaui_ice(ji-1,jj  ) * tmu(ji-1,jj  ) & 
     269                     +   utaui_ice(ji  ,jj  ) * tmu(ji  ,jj  ) ) / 2.0 
     270                  ztauy         = ( vtaui_ice(ji  ,jj-1) * tmv(ji  ,jj-1) & 
     271                     +   vtaui_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) / 2.0 
     272                  ! Square root of wind stress 
     273                  ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
     274 
     275                  !--------------------- 
     276                  ! Frazil ice velocity 
     277                  !--------------------- 
     278                  zvfrx         = zgamafr * zsqcd * ztaux / MAX(ztenagm,zeps) 
     279                  zvfry         = zgamafr * zsqcd * ztauy / MAX(ztenagm,zeps) 
     280 
     281                  !------------------- 
     282                  ! Pack ice velocity 
     283                  !------------------- 
     284                  ! C-grid ice velocity 
     285                  zindb = MAX(0.0, SIGN(1.0, at_i(ji,jj) )) 
     286                  zvgx  = zindb * ( u_ice(ji-1,jj  ) * tmu(ji-1,jj  ) & 
     287                     + u_ice(ji,jj    ) * tmu(ji  ,jj  ) ) / 2.0 
     288                  zvgy  = zindb * ( v_ice(ji  ,jj-1) * tmv(ji  ,jj-1) & 
     289                     + v_ice(ji,jj    ) * tmv(ji  ,jj  ) ) / 2.0 
     290 
     291                  !----------------------------------- 
     292                  ! Relative frazil/pack ice velocity 
     293                  !----------------------------------- 
     294                  ! absolute relative velocity 
     295                  zvrel2        = MAX( ( zvfrx - zvgx ) * ( zvfrx - zvgx ) + & 
     296                     ( zvfry - zvgy ) * ( zvfry - zvgy )   & 
     297                     , 0.15 * 0.15 ) 
     298                  zvrel(ji,jj)  = SQRT(zvrel2) 
     299 
     300                  !--------------------- 
     301                  ! Iterative procedure 
     302                  !--------------------- 
     303                  hicol(ji,jj) = zhicrit + 0.1  
     304                  hicol(ji,jj) = zhicrit + hicol(ji,jj) /      &  
     305                     ( hicol(ji,jj) * hicol(ji,jj) - & 
     306                     zhicrit * zhicrit ) * ztwogp * zvrel2 
     307 
     308                  iter = 1 
     309                  iterate_frazil = .true. 
     310 
     311                  DO WHILE ( iter .LT. 100 .AND. iterate_frazil )  
     312                     zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) & 
     313                        - hicol(ji,jj) * zhicrit * ztwogp * zvrel2 
     314                     zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0*hicol(ji,jj) + zhicrit ) & 
     315                        - zhicrit * ztwogp * zvrel2 
     316                     zhicol_new = hicol(ji,jj) - zf/zfp 
     317                     hicol(ji,jj)   = zhicol_new 
     318 
     319                     iter = iter + 1 
     320 
     321                  END DO ! do while 
     322 
     323               ENDIF ! end of selection of pixels where ice forms 
     324 
     325            END DO ! loop on ji ends 
     326         END DO ! loop on jj ends 
    327327 
    328328      ENDIF ! End of computation of frazil ice collection thickness 
    329329 
    330 !------------------------------------------------------------------------------! 
    331 ! 4) Identify grid points where new ice forms 
    332 !------------------------------------------------------------------------------! 
     330      !------------------------------------------------------------------------------! 
     331      ! 4) Identify grid points where new ice forms 
     332      !------------------------------------------------------------------------------! 
    333333 
    334334      !------------------------------------- 
    … …  
    349349      END DO 
    350350 
    351       IF(lwp) THEN 
     351      IF( ln_nicep ) THEN 
    352352         WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 
    353353      ENDIF 
    … …  
    360360 
    361361      IF ( nbpac > 0 ) THEN 
    362           
    363         CALL tab_2d_1d( nbpac, zat_i_ac  (1:nbpac)     , at_i         ,       & 
    364                         jpi, jpj, npac(1:nbpac) ) 
    365         DO jl = 1, jpl 
    366            CALL tab_2d_1d( nbpac, za_i_ac(1:nbpac,jl)  , a_i(:,:,jl)  ,       & 
    367                            jpi, jpj, npac(1:nbpac) ) 
    368            CALL tab_2d_1d( nbpac, zv_i_ac(1:nbpac,jl)  , v_i(:,:,jl)  ,       & 
    369                            jpi, jpj, npac(1:nbpac) ) 
    370            CALL tab_2d_1d( nbpac, zoa_i_ac(1:nbpac,jl) , oa_i(:,:,jl) ,       & 
    371                            jpi, jpj, npac(1:nbpac) ) 
    372            CALL tab_2d_1d( nbpac, zsmv_i_ac(1:nbpac,jl), smv_i(:,:,jl),       & 
    373                            jpi, jpj, npac(1:nbpac) ) 
    374            DO jk = 1, nlay_i 
    375               CALL tab_2d_1d( nbpac, ze_i_ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , & 
    376                               jpi, jpj, npac(1:nbpac) ) 
    377            END DO ! jk 
    378         END DO ! jl 
    379  
    380         CALL tab_2d_1d( nbpac, qldif_1d  (1:nbpac)     , qldif ,              & 
    381                         jpi, jpj, npac(1:nbpac) ) 
    382         CALL tab_2d_1d( nbpac, qcmif_1d  (1:nbpac)     , qcmif ,              & 
    383                         jpi, jpj, npac(1:nbpac) ) 
    384         CALL tab_2d_1d( nbpac, t_bo_b    (1:nbpac)     , t_bo  ,              & 
    385                         jpi, jpj, npac(1:nbpac) ) 
    386         CALL tab_2d_1d( nbpac, fseqv_1d  (1:nbpac)     , fseqv ,              & 
    387                         jpi, jpj, npac(1:nbpac) ) 
    388         CALL tab_2d_1d( nbpac, hicol_b   (1:nbpac)     , hicol ,              & 
    389                         jpi, jpj, npac(1:nbpac) ) 
    390         CALL tab_2d_1d( nbpac, zvrel_ac  (1:nbpac)     , zvrel ,              & 
    391                         jpi, jpj, npac(1:nbpac) ) 
    392  
    393 !------------------------------------------------------------------------------! 
    394 ! 5) Compute thickness, salinity, enthalpy, age, area and volume of new ice 
    395 !------------------------------------------------------------------------------! 
    396  
    397         !---------------------- 
    398         ! Thickness of new ice 
    399         !---------------------- 
    400         DO ji = 1, nbpac 
    401            zh_newice(ji)     = hiccrit(1) 
    402         END DO 
    403         IF ( fraz_swi .EQ. 1.0 ) zh_newice(:) = hicol_b(:) 
    404  
    405         !---------------------- 
    406         ! Salinity of new ice  
    407         !---------------------- 
    408  
    409         IF ( num_sal .EQ. 1 ) THEN 
    410            zs_newice(:)      =   bulk_sal 
    411         ENDIF ! num_sal 
    412  
    413         IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN 
    414  
    415            DO ji = 1, nbpac 
    416               zs_newice(ji)  =   MIN( 4.606 + 0.91 / zh_newice(ji) , s_i_max ) 
    417               zji            =   MOD( npac(ji) - 1, jpi ) + 1 
    418               zjj            =   ( npac(ji) - 1 ) / jpi + 1 
    419               zs_newice(ji)  =   MIN( 0.5*sss_m(zji,zjj) , zs_newice(ji) ) 
    420            END DO ! jl 
    421  
    422         ENDIF ! num_sal 
    423  
    424         IF ( num_sal .EQ. 3 ) THEN 
    425            zs_newice(:)      =   2.3 
    426         ENDIF ! num_sal 
    427  
    428         !------------------------- 
    429         ! Heat content of new ice 
    430         !------------------------- 
    431         ! We assume that new ice is formed at the seawater freezing point 
    432         DO ji = 1, nbpac 
    433            ztmelts           = - tmut * zs_newice(ji) + rtt ! Melting point (K) 
    434            ze_newice(ji)     =   rhoic * ( cpic * ( ztmelts - t_bo_b(ji) )    & 
    435                                          + lfus * ( 1.0 - ( ztmelts - rtt )   & 
    436                                            / ( t_bo_b(ji) - rtt ) )           & 
    437                                          - rcp * ( ztmelts-rtt ) ) 
    438            ze_newice(ji)     =   MAX( ze_newice(ji) , 0.0 ) +                 & 
    439                                  MAX( 0.0 , SIGN( 1.0 , - ze_newice(ji) ) )   &  
    440                                  * rhoic * lfus 
    441         END DO ! ji 
    442         !---------------- 
    443         ! Age of new ice 
    444         !---------------- 
    445         DO ji = 1, nbpac 
    446            zo_newice(ji)     = 0.0 
    447         END DO ! ji 
    448  
    449         !-------------------------- 
    450         ! Open water energy budget  
    451         !-------------------------- 
    452         DO ji = 1, nbpac 
    453            zqbgow(ji)        = qldif_1d(ji) - qcmif_1d(ji) !<0 
    454         END DO ! ji 
    455  
    456         !------------------- 
    457         ! Volume of new ice 
    458         !------------------- 
    459         DO ji = 1, nbpac 
    460            zv_newice(ji)     = - zqbgow(ji) / ze_newice(ji) 
    461  
    462            ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
    463            zfrazb        = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) )     &  
    464                              + 1.0 ) / 2.0 * maxfrazb 
    465            zdh_frazb(ji) = zfrazb*zv_newice(ji) 
    466            zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
    467         END DO 
    468  
    469         !--------------------------------- 
    470         ! Salt flux due to new ice growth 
    471         !--------------------------------- 
    472         IF ( ( num_sal .EQ. 4 ) ) THEN  
    473            DO ji = 1, nbpac 
    474               zji            = MOD( npac(ji) - 1, jpi ) + 1 
    475               zjj            = ( npac(ji) - 1 ) / jpi + 1 
    476               fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
    477                                ( sss_m(zji,zjj) - bulk_sal      ) * rhoic *       & 
    478                                zv_newice(ji) / rdt_ice 
    479            END DO 
    480         ELSE 
    481            DO ji = 1, nbpac 
    482               zji            = MOD( npac(ji) - 1, jpi ) + 1 
    483               zjj            = ( npac(ji) - 1 ) / jpi + 1 
    484               fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
    485                                ( sss_m(zji,zjj) - zs_newice(ji) ) * rhoic *       & 
    486                                zv_newice(ji) / rdt_ice 
    487            END DO ! ji 
    488         ENDIF 
    489  
    490         !------------------------------------ 
    491         ! Diags for energy conservation test 
    492         !------------------------------------ 
    493         DO ji = 1, nbpac 
    494            ! Volume 
    495            zji                  = MOD( npac(ji) - 1, jpi ) + 1 
    496            zjj                  = ( npac(ji) - 1 ) / jpi + 1 
    497            vt_i_init(zji,zjj)   = vt_i_init(zji,zjj) + zv_newice(ji) 
    498            ! Energy 
    499            zde                  = ze_newice(ji) / unit_fac 
    500            zde                  = zde * area(zji,zjj) * zv_newice(ji) 
    501            et_i_init(zji,zjj)   = et_i_init(zji,zjj) + zde 
    502         END DO 
    503  
    504         ! keep new ice volume in memory 
    505         CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , & 
    506                         jpi, jpj ) 
    507  
    508         !----------------- 
    509         ! Area of new ice 
    510         !----------------- 
    511         DO ji = 1, nbpac 
    512            za_newice(ji)     = zv_newice(ji) / zh_newice(ji) 
    513            ! diagnostic 
    514            zji                  = MOD( npac(ji) - 1, jpi ) + 1 
    515            zjj                  = ( npac(ji) - 1 ) / jpi + 1 
    516            diag_lat_gr(zji,zjj) = zv_newice(ji) / rdt_ice 
    517         END DO !ji 
    518  
    519 !------------------------------------------------------------------------------! 
    520 ! 6) Redistribute new ice area and volume into ice categories                  ! 
    521 !------------------------------------------------------------------------------! 
    522  
    523         !----------------------------------------- 
    524         ! Keep old ice areas and volume in memory 
    525         !----------------------------------------- 
    526         zv_old(:,:) = zv_i_ac(:,:)  
    527         za_old(:,:) = za_i_ac(:,:) 
    528  
    529         !------------------------------------------- 
    530         ! Compute excessive new ice area and volume 
    531         !------------------------------------------- 
    532         ! If lateral ice growth gives an ice concentration gt 1, then 
    533         ! we keep the excessive volume in memory and attribute it later 
    534         ! to bottom accretion 
    535         DO ji = 1, nbpac 
    536            ! vectorize 
    537            IF ( za_newice(ji) .GT. ( 1.0 - zat_i_ac(ji) ) ) THEN 
    538               zda_res(ji)    = za_newice(ji) - (1.0 - zat_i_ac(ji) ) 
    539               zdv_res(ji)    = zda_res(ji) * zh_newice(ji)  
    540               za_newice(ji)  = za_newice(ji) - zda_res(ji) 
    541               zv_newice(ji)  = zv_newice(ji) - zdv_res(ji) 
    542            ELSE 
    543               zda_res(ji) = 0.0 
    544               zdv_res(ji) = 0.0 
    545            ENDIF 
    546         END DO ! ji 
    547  
    548         !------------------------------------------------ 
    549         ! Laterally redistribute new ice volume and area 
    550         !------------------------------------------------ 
    551         zat_i_ac(:) = 0.0 
    552  
    553         DO jl = 1, jpl 
    554            DO ji = 1, nbpac 
    555               ! vectorize 
    556               IF (       ( hi_max(jl-1)  .LT. zh_newice(ji) ) & 
    557                    .AND. ( zh_newice(ji) .LE. hi_max(jl)    ) ) THEN 
    558                  za_i_ac(ji,jl) = za_i_ac(ji,jl) + za_newice(ji) 
    559                  zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zv_newice(ji) 
    560                  zat_i_ac(ji)   = zat_i_ac(ji) + za_i_ac(ji,jl) 
    561                  zcatac(ji)     = jl 
    562               ENDIF 
    563            END DO ! ji 
    564         END DO ! jl 
    565               
    566         !---------------------------------- 
    567         ! Heat content - lateral accretion 
    568         !---------------------------------- 
    569         DO ji = 1, nbpac 
    570            jl = zcatac(ji) ! categroy in which new ice is put 
    571            ! zindb = 0 if no ice and 1 if yes 
    572            zindb            = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , -za_old(ji,jl) ) )  
    573            ! old ice thickness 
    574            zhice_old(ji,jl)  = zv_old(ji,jl)                                  & 
    575                              / MAX ( za_old(ji,jl) , zeps ) * zindb 
    576            ! difference in thickness 
    577            zdhex(ji)      = MAX( 0.0, zh_newice(ji) - zhice_old(ji,jl) )  
    578            ! is ice totally new in category jl ? 
    579            zswinew(ji)    = MAX( 0.0, SIGN( 1.0 , - za_old(ji,jl) + epsi11 ) ) 
    580         END DO 
    581  
    582         DO jk = 1, nlay_i 
    583            DO ji = 1, nbpac 
    584               jl = zcatac(ji) 
    585               zqold              = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 
    586               zalphai            = MIN( zhice_old(ji,jl) * jk  / nlay_i ,     & 
    587                                         zh_newice(ji) )                       & 
    588                                  - MIN( zhice_old(ji,jl) * ( jk - 1 )         & 
    589                                         / nlay_i , zh_newice(ji) ) 
    590               ze_i_ac(ji,jk,jl) =                                             & 
    591               zswinew(ji)           * ze_newice(ji)                           & 
    592             + ( 1.0 - zswinew(ji) ) *                                         & 
    593               ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / nlay_i            & 
    594               + za_newice(ji)  * ze_newice(ji) * zalphai                      & 
    595               + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / nlay_i ) /       & 
    596               ( ( zv_i_ac(ji,jl) ) / nlay_i ) 
    597  
    598            END DO !ji 
    599         END DO !jl 
    600  
    601         !----------------------------------------------- 
    602         ! Add excessive volume of new ice at the bottom 
    603         !----------------------------------------------- 
    604         ! If the ice concentration exceeds 1, the remaining volume of new ice 
    605         ! is equally redistributed among all ice categories in which there is 
    606         ! ice 
    607  
    608         ! Fraction of level ice 
    609         jm = 1 
    610         zat_i_lev(:) = 0.0 
    611  
    612         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    613            DO ji = 1, nbpac 
    614               zat_i_lev(ji) = zat_i_lev(ji) + za_i_ac(ji,jl)  
    615            END DO 
    616         END DO 
    617  
    618         WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 
    619         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    620            DO ji = 1, nbpac 
    621               zindb      =  MAX( 0.0, SIGN( 1.0, zdv_res(ji) ) ) 
    622               zv_i_ac(ji,jl) = zv_i_ac(ji,jl) +                               & 
    623                                zindb * zdv_res(ji) * za_i_ac(ji,jl) /         & 
    624                                MAX( zat_i_lev(ji) , epsi06 ) 
    625            END DO ! ji 
    626         END DO ! jl 
    627         WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 
    628  
    629         !--------------------------------- 
    630         ! Heat content - bottom accretion 
    631         !--------------------------------- 
    632         jm = 1 
    633         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    634            DO ji = 1, nbpac 
    635               ! zindb = 0 if no ice and 1 if yes 
    636               zindb            =  1.0 -  MAX( 0.0 , SIGN( 1.0                 &  
    637                                             , - za_i_ac(ji,jl ) ) )  
    638               zhice_old(ji,jl) =  zv_i_ac(ji,jl) /                            & 
    639                                     MAX( za_i_ac(ji,jl) , zeps ) * zindb 
    640               zdhicbot(ji,jl)  =  zdv_res(ji) / MAX( za_i_ac(ji,jl) , zeps )  &  
    641                                *  zindb & 
    642                                +  zindb * zdh_frazb(ji) ! frazil ice  
    643                                                         ! may coalesce 
    644               ! thickness of residual ice 
    645               zdummy(ji,jl)    = zv_i_ac(ji,jl)/MAX(za_i_ac(ji,jl),zeps)*zindb 
    646            END DO !ji 
    647         END DO !jl 
    648  
    649         ! old layers thicknesses and enthalpies 
    650         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    651            DO jk = 1, nlay_i 
    652               DO ji = 1, nbpac 
    653                  zthick0(ji,jk,jl)=  zhice_old(ji,jl) / nlay_i 
    654                  zqm0   (ji,jk,jl)=  ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl) 
    655               END DO !ji 
    656            END DO !jk 
    657         END DO !jl 
    658  
    659         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    660            DO ji = 1, nbpac 
    661               zthick0(ji,nlay_i+1,jl) =  zdhicbot(ji,jl) 
    662               zqm0   (ji,nlay_i+1,jl) =  ze_newice(ji)*zdhicbot(ji,jl) 
    663            END DO ! ji 
    664         END DO ! jl 
    665  
    666         ! Redistributing energy on the new grid 
    667         ze_i_ac(:,:,:) = 0.0 
    668         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    669            DO jk = 1, nlay_i 
    670               DO layer = 1, nlay_i + 1 
    671                  DO ji = 1, nbpac 
    672                     zindb            =  1.0 -  MAX( 0.0 , SIGN( 1.0 ,         &  
    673                                                     - za_i_ac(ji,jl ) ) )  
    674                     ! Redistributing energy on the new grid 
    675                     zweight         =  MAX (  & 
    676                     MIN( zhice_old(ji,jl) * layer , zdummy(ji,jl) * jk ) -    & 
    677                     MAX( zhice_old(ji,jl) * ( layer - 1 ) , zdummy(ji,jl) *   & 
     362 
     363         CALL tab_2d_1d( nbpac, zat_i_ac  (1:nbpac)     , at_i         ,       & 
     364            jpi, jpj, npac(1:nbpac) ) 
     365         DO jl = 1, jpl 
     366            CALL tab_2d_1d( nbpac, za_i_ac(1:nbpac,jl)  , a_i(:,:,jl)  ,       & 
     367               jpi, jpj, npac(1:nbpac) ) 
     368            CALL tab_2d_1d( nbpac, zv_i_ac(1:nbpac,jl)  , v_i(:,:,jl)  ,       & 
     369               jpi, jpj, npac(1:nbpac) ) 
     370            CALL tab_2d_1d( nbpac, zoa_i_ac(1:nbpac,jl) , oa_i(:,:,jl) ,       & 
     371               jpi, jpj, npac(1:nbpac) ) 
     372            CALL tab_2d_1d( nbpac, zsmv_i_ac(1:nbpac,jl), smv_i(:,:,jl),       & 
     373               jpi, jpj, npac(1:nbpac) ) 
     374            DO jk = 1, nlay_i 
     375               CALL tab_2d_1d( nbpac, ze_i_ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , & 
     376                  jpi, jpj, npac(1:nbpac) ) 
     377            END DO ! jk 
     378         END DO ! jl 
     379 
     380         CALL tab_2d_1d( nbpac, qldif_1d  (1:nbpac)     , qldif ,              & 
     381            jpi, jpj, npac(1:nbpac) ) 
     382         CALL tab_2d_1d( nbpac, qcmif_1d  (1:nbpac)     , qcmif ,              & 
     383            jpi, jpj, npac(1:nbpac) ) 
     384         CALL tab_2d_1d( nbpac, t_bo_b    (1:nbpac)     , t_bo  ,              & 
     385            jpi, jpj, npac(1:nbpac) ) 
     386         CALL tab_2d_1d( nbpac, fseqv_1d  (1:nbpac)     , fseqv ,              & 
     387            jpi, jpj, npac(1:nbpac) ) 
     388         CALL tab_2d_1d( nbpac, hicol_b   (1:nbpac)     , hicol ,              & 
     389            jpi, jpj, npac(1:nbpac) ) 
     390         CALL tab_2d_1d( nbpac, zvrel_ac  (1:nbpac)     , zvrel ,              & 
     391            jpi, jpj, npac(1:nbpac) ) 
     392 
     393         !------------------------------------------------------------------------------! 
     394         ! 5) Compute thickness, salinity, enthalpy, age, area and volume of new ice 
     395         !------------------------------------------------------------------------------! 
     396 
     397         !---------------------- 
     398         ! Thickness of new ice 
     399         !---------------------- 
     400         DO ji = 1, nbpac 
     401            zh_newice(ji)     = hiccrit(1) 
     402         END DO 
     403         IF ( fraz_swi .EQ. 1.0 ) zh_newice(:) = hicol_b(:) 
     404 
     405         !---------------------- 
     406         ! Salinity of new ice  
     407         !---------------------- 
     408 
     409         IF ( num_sal .EQ. 1 ) THEN 
     410            zs_newice(:)      =   bulk_sal 
     411         ENDIF ! num_sal 
     412 
     413         IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN 
     414 
     415            DO ji = 1, nbpac 
     416               zs_newice(ji)  =   MIN( 4.606 + 0.91 / zh_newice(ji) , s_i_max ) 
     417               zji            =   MOD( npac(ji) - 1, jpi ) + 1 
     418               zjj            =   ( npac(ji) - 1 ) / jpi + 1 
     419               zs_newice(ji)  =   MIN( 0.5*sss_m(zji,zjj) , zs_newice(ji) ) 
     420            END DO ! jl 
     421 
     422         ENDIF ! num_sal 
     423 
     424         IF ( num_sal .EQ. 3 ) THEN 
     425            zs_newice(:)      =   2.3 
     426         ENDIF ! num_sal 
     427 
     428         !------------------------- 
     429         ! Heat content of new ice 
     430         !------------------------- 
     431         ! We assume that new ice is formed at the seawater freezing point 
     432         DO ji = 1, nbpac 
     433            ztmelts           = - tmut * zs_newice(ji) + rtt ! Melting point (K) 
     434            ze_newice(ji)     =   rhoic * ( cpic * ( ztmelts - t_bo_b(ji) )    & 
     435               + lfus * ( 1.0 - ( ztmelts - rtt )   & 
     436               / ( t_bo_b(ji) - rtt ) )           & 
     437               - rcp * ( ztmelts-rtt ) ) 
     438            ze_newice(ji)     =   MAX( ze_newice(ji) , 0.0 ) +                 & 
     439               MAX( 0.0 , SIGN( 1.0 , - ze_newice(ji) ) )   &  
     440               * rhoic * lfus 
     441         END DO ! ji 
     442         !---------------- 
     443         ! Age of new ice 
     444         !---------------- 
     445         DO ji = 1, nbpac 
     446            zo_newice(ji)     = 0.0 
     447         END DO ! ji 
     448 
     449         !-------------------------- 
     450         ! Open water energy budget  
     451         !-------------------------- 
     452         DO ji = 1, nbpac 
     453            zqbgow(ji)        = qldif_1d(ji) - qcmif_1d(ji) !<0 
     454         END DO ! ji 
     455 
     456         !------------------- 
     457         ! Volume of new ice 
     458         !------------------- 
     459         DO ji = 1, nbpac 
     460            zv_newice(ji)     = - zqbgow(ji) / ze_newice(ji) 
     461 
     462            ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
     463            zfrazb        = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) )     &  
     464               + 1.0 ) / 2.0 * maxfrazb 
     465            zdh_frazb(ji) = zfrazb*zv_newice(ji) 
     466            zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
     467         END DO 
     468 
     469         !--------------------------------- 
     470         ! Salt flux due to new ice growth 
     471         !--------------------------------- 
     472         IF ( ( num_sal .EQ. 4 ) ) THEN  
     473            DO ji = 1, nbpac 
     474               zji            = MOD( npac(ji) - 1, jpi ) + 1 
     475               zjj            = ( npac(ji) - 1 ) / jpi + 1 
     476               fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
     477                  ( sss_m(zji,zjj) - bulk_sal      ) * rhoic *       & 
     478                  zv_newice(ji) / rdt_ice 
     479            END DO 
     480         ELSE 
     481            DO ji = 1, nbpac 
     482               zji            = MOD( npac(ji) - 1, jpi ) + 1 
     483               zjj            = ( npac(ji) - 1 ) / jpi + 1 
     484               fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
     485                  ( sss_m(zji,zjj) - zs_newice(ji) ) * rhoic *       & 
     486                  zv_newice(ji) / rdt_ice 
     487            END DO ! ji 
     488         ENDIF 
     489 
     490         !------------------------------------ 
     491         ! Diags for energy conservation test 
     492         !------------------------------------ 
     493         DO ji = 1, nbpac 
     494            ! Volume 
     495            zji                  = MOD( npac(ji) - 1, jpi ) + 1 
     496            zjj                  = ( npac(ji) - 1 ) / jpi + 1 
     497            vt_i_init(zji,zjj)   = vt_i_init(zji,zjj) + zv_newice(ji) 
     498            ! Energy 
     499            zde                  = ze_newice(ji) / unit_fac 
     500            zde                  = zde * area(zji,zjj) * zv_newice(ji) 
     501            et_i_init(zji,zjj)   = et_i_init(zji,zjj) + zde 
     502         END DO 
     503 
     504         ! keep new ice volume in memory 
     505         CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , & 
     506            jpi, jpj ) 
     507 
     508         !----------------- 
     509         ! Area of new ice 
     510         !----------------- 
     511         DO ji = 1, nbpac 
     512            za_newice(ji)     = zv_newice(ji) / zh_newice(ji) 
     513            ! diagnostic 
     514            zji                  = MOD( npac(ji) - 1, jpi ) + 1 
     515            zjj                  = ( npac(ji) - 1 ) / jpi + 1 
     516            diag_lat_gr(zji,zjj) = zv_newice(ji) / rdt_ice 
     517         END DO !ji 
     518 
     519         !------------------------------------------------------------------------------! 
     520         ! 6) Redistribute new ice area and volume into ice categories                  ! 
     521         !------------------------------------------------------------------------------! 
     522 
     523         !----------------------------------------- 
     524         ! Keep old ice areas and volume in memory 
     525         !----------------------------------------- 
     526         zv_old(:,:) = zv_i_ac(:,:)  
     527         za_old(:,:) = za_i_ac(:,:) 
     528 
     529         !------------------------------------------- 
     530         ! Compute excessive new ice area and volume 
     531         !------------------------------------------- 
     532         ! If lateral ice growth gives an ice concentration gt 1, then 
     533         ! we keep the excessive volume in memory and attribute it later 
     534         ! to bottom accretion 
     535         DO ji = 1, nbpac 
     536            ! vectorize 
     537            IF ( za_newice(ji) .GT. ( 1.0 - zat_i_ac(ji) ) ) THEN 
     538               zda_res(ji)    = za_newice(ji) - (1.0 - zat_i_ac(ji) ) 
     539               zdv_res(ji)    = zda_res(ji) * zh_newice(ji)  
     540               za_newice(ji)  = za_newice(ji) - zda_res(ji) 
     541               zv_newice(ji)  = zv_newice(ji) - zdv_res(ji) 
     542            ELSE 
     543               zda_res(ji) = 0.0 
     544               zdv_res(ji) = 0.0 
     545            ENDIF 
     546         END DO ! ji 
     547 
     548         !------------------------------------------------ 
     549         ! Laterally redistribute new ice volume and area 
     550         !------------------------------------------------ 
     551         zat_i_ac(:) = 0.0 
     552 
     553         DO jl = 1, jpl 
     554            DO ji = 1, nbpac 
     555               ! vectorize 
     556               IF (       ( hi_max(jl-1)  .LT. zh_newice(ji) ) & 
     557                  .AND. ( zh_newice(ji) .LE. hi_max(jl)    ) ) THEN 
     558                  za_i_ac(ji,jl) = za_i_ac(ji,jl) + za_newice(ji) 
     559                  zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zv_newice(ji) 
     560                  zat_i_ac(ji)   = zat_i_ac(ji) + za_i_ac(ji,jl) 
     561                  zcatac(ji)     = jl 
     562               ENDIF 
     563            END DO ! ji 
     564         END DO ! jl 
     565 
     566         !---------------------------------- 
     567         ! Heat content - lateral accretion 
     568         !---------------------------------- 
     569         DO ji = 1, nbpac 
     570            jl = zcatac(ji) ! categroy in which new ice is put 
     571            ! zindb = 0 if no ice and 1 if yes 
     572            zindb            = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , -za_old(ji,jl) ) )  
     573            ! old ice thickness 
     574            zhice_old(ji,jl)  = zv_old(ji,jl)                                  & 
     575               / MAX ( za_old(ji,jl) , zeps ) * zindb 
     576            ! difference in thickness 
     577            zdhex(ji)      = MAX( 0.0, zh_newice(ji) - zhice_old(ji,jl) )  
     578            ! is ice totally new in category jl ? 
     579            zswinew(ji)    = MAX( 0.0, SIGN( 1.0 , - za_old(ji,jl) + epsi11 ) ) 
     580         END DO 
     581 
     582         DO jk = 1, nlay_i 
     583            DO ji = 1, nbpac 
     584               jl = zcatac(ji) 
     585               zqold              = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 
     586               zalphai            = MIN( zhice_old(ji,jl) * jk  / nlay_i ,     & 
     587                  zh_newice(ji) )                       & 
     588                  - MIN( zhice_old(ji,jl) * ( jk - 1 )         & 
     589                  / nlay_i , zh_newice(ji) ) 
     590               ze_i_ac(ji,jk,jl) =                                             & 
     591                  zswinew(ji)           * ze_newice(ji)                           & 
     592                  + ( 1.0 - zswinew(ji) ) *                                         & 
     593                  ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / nlay_i            & 
     594                  + za_newice(ji)  * ze_newice(ji) * zalphai                      & 
     595                  + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / nlay_i ) /       & 
     596                  ( ( zv_i_ac(ji,jl) ) / nlay_i ) 
     597 
     598            END DO !ji 
     599         END DO !jl 
     600 
     601         !----------------------------------------------- 
     602         ! Add excessive volume of new ice at the bottom 
     603         !----------------------------------------------- 
     604         ! If the ice concentration exceeds 1, the remaining volume of new ice 
     605         ! is equally redistributed among all ice categories in which there is 
     606         ! ice 
     607 
     608         ! Fraction of level ice 
     609         jm = 1 
     610         zat_i_lev(:) = 0.0 
     611 
     612         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     613            DO ji = 1, nbpac 
     614               zat_i_lev(ji) = zat_i_lev(ji) + za_i_ac(ji,jl)  
     615            END DO 
     616         END DO 
     617 
     618         IF( ln_nicep ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 
     619         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     620            DO ji = 1, nbpac 
     621               zindb      =  MAX( 0.0, SIGN( 1.0, zdv_res(ji) ) ) 
     622               zv_i_ac(ji,jl) = zv_i_ac(ji,jl) +                               & 
     623                  zindb * zdv_res(ji) * za_i_ac(ji,jl) /         & 
     624                  MAX( zat_i_lev(ji) , epsi06 ) 
     625            END DO ! ji 
     626         END DO ! jl 
     627         IF( ln_nicep ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 
     628 
     629         !--------------------------------- 
     630         ! Heat content - bottom accretion 
     631         !--------------------------------- 
     632         jm = 1 
     633         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     634            DO ji = 1, nbpac 
     635               ! zindb = 0 if no ice and 1 if yes 
     636               zindb            =  1.0 -  MAX( 0.0 , SIGN( 1.0                 &  
     637                  , - za_i_ac(ji,jl ) ) )  
     638               zhice_old(ji,jl) =  zv_i_ac(ji,jl) /                            & 
     639                  MAX( za_i_ac(ji,jl) , zeps ) * zindb 
     640               zdhicbot(ji,jl)  =  zdv_res(ji) / MAX( za_i_ac(ji,jl) , zeps )  &  
     641                  *  zindb & 
     642                  +  zindb * zdh_frazb(ji) ! frazil ice  
     643               ! may coalesce 
     644               ! thickness of residual ice 
     645               zdummy(ji,jl)    = zv_i_ac(ji,jl)/MAX(za_i_ac(ji,jl),zeps)*zindb 
     646            END DO !ji 
     647         END DO !jl 
     648 
     649         ! old layers thicknesses and enthalpies 
     650         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     651            DO jk = 1, nlay_i 
     652               DO ji = 1, nbpac 
     653                  zthick0(ji,jk,jl)=  zhice_old(ji,jl) / nlay_i 
     654                  zqm0   (ji,jk,jl)=  ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl) 
     655               END DO !ji 
     656            END DO !jk 
     657         END DO !jl 
     658 
     659         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     660            DO ji = 1, nbpac 
     661               zthick0(ji,nlay_i+1,jl) =  zdhicbot(ji,jl) 
     662               zqm0   (ji,nlay_i+1,jl) =  ze_newice(ji)*zdhicbot(ji,jl) 
     663            END DO ! ji 
     664         END DO ! jl 
     665 
     666         ! Redistributing energy on the new grid 
     667         ze_i_ac(:,:,:) = 0.0 
     668         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     669            DO jk = 1, nlay_i 
     670               DO layer = 1, nlay_i + 1 
     671                  DO ji = 1, nbpac 
     672                     zindb            =  1.0 -  MAX( 0.0 , SIGN( 1.0 ,         &  
     673                        - za_i_ac(ji,jl ) ) )  
     674                     ! Redistributing energy on the new grid 
     675                     zweight         =  MAX (  & 
     676                        MIN( zhice_old(ji,jl) * layer , zdummy(ji,jl) * jk ) -    & 
     677                        MAX( zhice_old(ji,jl) * ( layer - 1 ) , zdummy(ji,jl) *   & 
    678678                        ( jk - 1 ) ) , 0.0 )                                  & 
    679                     /  ( MAX(nlay_i * zthick0(ji,layer,jl),zeps) ) * zindb 
    680                     ze_i_ac(ji,jk,jl) =  ze_i_ac(ji,jk,jl) +                  & 
    681                                          zweight * zqm0(ji,layer,jl)   
    682                  END DO ! ji 
    683               END DO ! layer 
    684            END DO ! jk 
    685         END DO ! jl 
    686  
    687         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    688            DO jk = 1, nlay_i 
    689               DO ji = 1, nbpac 
    690                  zindb                =  1.0 - MAX( 0.0 , SIGN( 1.0           & 
    691                                       , - zv_i_ac(ji,jl) ) ) !0 if no ice  
    692                  ze_i_ac(ji,jk,jl)    = ze_i_ac(ji,jk,jl) /                   & 
    693                                         MAX( zv_i_ac(ji,jl) , zeps)           & 
    694                                         * za_i_ac(ji,jl) * nlay_i * zindb 
    695               END DO 
    696            END DO 
    697         END DO 
    698  
    699         !------------ 
    700         ! Update age  
    701         !------------ 
    702         DO jl = 1, jpl 
    703            DO ji = 1, nbpac 
    704               !--ice age 
    705               zindb            = 1.0 - MAX( 0.0 , SIGN( 1.0 , -               & 
    706                                  za_i_ac(ji,jl) ) )  ! 0 if no ice and 1 if yes 
    707               zoa_i_ac(ji,jl)  = za_old(ji,jl) * zoa_i_ac(ji,jl) /            & 
    708                                  MAX( za_i_ac(ji,jl) , zeps ) * zindb    
    709            END DO ! ji 
    710         END DO ! jl    
    711  
    712         !----------------- 
    713         ! Update salinity 
    714         !----------------- 
    715         IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN 
    716  
    717         DO jl = 1, jpl 
    718            DO ji = 1, nbpac 
    719               !zindb = 0 if no ice and 1 if yes 
    720               zindb            = 1.0 - MAX( 0.0 , SIGN( 1.0 , -               & 
    721                                  zv_i_ac(ji,jl) ) )  ! 0 if no ice and 1 if yes 
    722               zdv              = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    723               zsmv_i_ac(ji,jl) = ( zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) ) * & 
    724                                  zindb 
    725            END DO ! ji 
    726         END DO ! jl    
    727  
    728         ENDIF ! num_sal 
    729    
    730  
    731 !------------------------------------------------------------------------------! 
    732 ! 8) Change 2D vectors to 1D vectors  
    733 !------------------------------------------------------------------------------! 
    734  
    735         DO jl = 1, jpl 
    736            CALL tab_1d_2d( nbpac, a_i(:,:,jl) , npac(1:nbpac) ,               & 
    737                                   za_i_ac(1:nbpac,jl) , jpi, jpj ) 
    738            CALL tab_1d_2d( nbpac, v_i(:,:,jl) , npac(1:nbpac) ,               & 
    739                                   zv_i_ac(1:nbpac,jl) , jpi, jpj ) 
    740            CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac) ,               & 
    741                                   zoa_i_ac(1:nbpac,jl), jpi, jpj ) 
    742            IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 
    743            CALL tab_1d_2d( nbpac, smv_i(:,:,jl) , npac(1:nbpac) ,             & 
    744                                      zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 
    745            DO jk = 1, nlay_i 
    746               CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl) , npac(1:nbpac),          & 
    747                                      ze_i_ac(1:nbpac,jk,jl), jpi, jpj ) 
    748            END DO ! jk 
    749         END DO !jl 
    750         CALL tab_1d_2d( nbpac, fseqv , npac(1:nbpac), fseqv_1d  (1:nbpac) ,   & 
    751                         jpi, jpj ) 
    752  
    753      ENDIF ! nbpac > 0 
    754  
    755 !------------------------------------------------------------------------------! 
    756 ! 9) Change units for e_i 
    757 !------------------------------------------------------------------------------!     
     679                        /  ( MAX(nlay_i * zthick0(ji,layer,jl),zeps) ) * zindb 
     680                     ze_i_ac(ji,jk,jl) =  ze_i_ac(ji,jk,jl) +                  & 
     681                        zweight * zqm0(ji,layer,jl)   
     682                  END DO ! ji 
     683               END DO ! layer 
     684            END DO ! jk 
     685         END DO ! jl 
     686 
     687         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     688            DO jk = 1, nlay_i 
     689               DO ji = 1, nbpac 
     690                  zindb                =  1.0 - MAX( 0.0 , SIGN( 1.0           & 
     691                     , - zv_i_ac(ji,jl) ) ) !0 if no ice  
     692                  ze_i_ac(ji,jk,jl)    = ze_i_ac(ji,jk,jl) /                   & 
     693                     MAX( zv_i_ac(ji,jl) , zeps)           & 
     694                     * za_i_ac(ji,jl) * nlay_i * zindb 
     695               END DO 
     696            END DO 
     697         END DO 
     698 
     699         !------------ 
     700         ! Update age  
     701         !------------ 
     702         DO jl = 1, jpl 
     703            DO ji = 1, nbpac 
     704               !--ice age 
     705               zindb            = 1.0 - MAX( 0.0 , SIGN( 1.0 , -               & 
     706                  za_i_ac(ji,jl) ) )  ! 0 if no ice and 1 if yes 
     707               zoa_i_ac(ji,jl)  = za_old(ji,jl) * zoa_i_ac(ji,jl) /            & 
     708                  MAX( za_i_ac(ji,jl) , zeps ) * zindb    
     709            END DO ! ji 
     710         END DO ! jl    
     711 
     712         !----------------- 
     713         ! Update salinity 
     714         !----------------- 
     715         IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN 
     716 
     717            DO jl = 1, jpl 
     718               DO ji = 1, nbpac 
     719                  !zindb = 0 if no ice and 1 if yes 
     720                  zindb            = 1.0 - MAX( 0.0 , SIGN( 1.0 , -               & 
     721                     zv_i_ac(ji,jl) ) )  ! 0 if no ice and 1 if yes 
     722                  zdv              = zv_i_ac(ji,jl) - zv_old(ji,jl) 
     723                  zsmv_i_ac(ji,jl) = ( zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) ) * & 
     724                     zindb 
     725               END DO ! ji 
     726            END DO ! jl    
     727 
     728         ENDIF ! num_sal 
     729 
     730 
     731         !------------------------------------------------------------------------------! 
     732         ! 8) Change 2D vectors to 1D vectors  
     733         !------------------------------------------------------------------------------! 
     734 
     735         DO jl = 1, jpl 
     736            CALL tab_1d_2d( nbpac, a_i(:,:,jl) , npac(1:nbpac) ,               & 
     737               za_i_ac(1:nbpac,jl) , jpi, jpj ) 
     738            CALL tab_1d_2d( nbpac, v_i(:,:,jl) , npac(1:nbpac) ,               & 
     739               zv_i_ac(1:nbpac,jl) , jpi, jpj ) 
     740            CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac) ,               & 
     741               zoa_i_ac(1:nbpac,jl), jpi, jpj ) 
     742            IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 
     743               CALL tab_1d_2d( nbpac, smv_i(:,:,jl) , npac(1:nbpac) ,             & 
     744               zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 
     745            DO jk = 1, nlay_i 
     746               CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl) , npac(1:nbpac),          & 
     747                  ze_i_ac(1:nbpac,jk,jl), jpi, jpj ) 
     748            END DO ! jk 
     749         END DO !jl 
     750         CALL tab_1d_2d( nbpac, fseqv , npac(1:nbpac), fseqv_1d  (1:nbpac) ,   & 
     751            jpi, jpj ) 
     752 
     753      ENDIF ! nbpac > 0 
     754 
     755      !------------------------------------------------------------------------------! 
     756      ! 9) Change units for e_i 
     757      !------------------------------------------------------------------------------!     
    758758 
    759759      DO jl = 1, jpl 
    … …  
    767767                  ! of layers to get heat content in 10^9 Joules 
    768768                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * & 
    769                                        area(ji,jj) * v_i(ji,jj,jl) / & 
    770                                        nlay_i 
     769                     area(ji,jj) * v_i(ji,jj,jl) / & 
     770                     nlay_i 
    771771               END DO 
    772772            END DO 
    773773         END DO 
    774774      END DO 
    775       
    776 !------------------------------------------------------------------------------| 
    777 ! 10) Conservation check and changes in each ice category 
    778 !------------------------------------------------------------------------------| 
     775 
     776      !------------------------------------------------------------------------------| 
     777      ! 10) Conservation check and changes in each ice category 
     778      !------------------------------------------------------------------------------| 
    779779 
    780780      IF ( con_i ) THEN  
    781       CALL lim_column_sum (jpl,   v_i, vt_i_final) 
    782       fieldid = 'v_i, limthd_lac' 
    783       CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid)  
    784  
    785       CALL lim_column_sum_energy(jpl, nlay_i, e_i, et_i_final) 
    786       fieldid = 'e_i, limthd_lac' 
    787       CALL lim_cons_check (et_i_final, et_i_final, 1.0e-3, fieldid)  
    788        
    789       CALL lim_column_sum (jpl,   v_s, vt_s_final) 
    790       fieldid = 'v_s, limthd_lac' 
    791       CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)  
    792  
    793 !     CALL lim_column_sum (jpl,   e_s(:,:,1,:) , et_s_init) 
    794 !     fieldid = 'e_s, limthd_lac' 
    795 !     CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid)  
    796  
    797       WRITE(numout,*) ' vt_i_init : ', vt_i_init(jiindx,jjindx) 
    798       WRITE(numout,*) ' vt_i_final: ', vt_i_final(jiindx,jjindx) 
    799       WRITE(numout,*) ' et_i_init : ', et_i_init(jiindx,jjindx) 
    800       WRITE(numout,*) ' et_i_final: ', et_i_final(jiindx,jjindx) 
     781         CALL lim_column_sum (jpl,   v_i, vt_i_final) 
     782         fieldid = 'v_i, limthd_lac' 
     783         CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid)  
     784 
     785         CALL lim_column_sum_energy(jpl, nlay_i, e_i, et_i_final) 
     786         fieldid = 'e_i, limthd_lac' 
     787         CALL lim_cons_check (et_i_final, et_i_final, 1.0e-3, fieldid)  
     788 
     789         CALL lim_column_sum (jpl,   v_s, vt_s_final) 
     790         fieldid = 'v_s, limthd_lac' 
     791         CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)  
     792 
     793         !     CALL lim_column_sum (jpl,   e_s(:,:,1,:) , et_s_init) 
     794         !     fieldid = 'e_s, limthd_lac' 
     795         !     CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid)  
     796 
     797         IF( ln_nicep ) THEN 
     798            WRITE(numout,*) ' vt_i_init : ', vt_i_init(jiindx,jjindx) 
     799            WRITE(numout,*) ' vt_i_final: ', vt_i_final(jiindx,jjindx) 
     800            WRITE(numout,*) ' et_i_init : ', et_i_init(jiindx,jjindx) 
     801            WRITE(numout,*) ' et_i_final: ', et_i_final(jiindx,jjindx) 
     802         ENDIF 
    801803 
    802804      ENDIF 

  • trunk/NEMO/LIM_SRC_3/limthd_sal.F90

    r888 r921  
    3838      zone   = 1.e0 
    3939 
    40    CONTAINS 
     40CONTAINS 
    4141 
    4242   SUBROUTINE lim_thd_sal(kideb,kiut) 
    … …  
    9595         zccc           ,    &   !: dummy factor 
    9696         zdiscrim                !: dummy factor 
    97   
     97 
    9898      REAL(wp), DIMENSION(jpij) ::          & 
    9999         ze_init        ,    &   !initial total enthalpy 
    … …  
    103103      !!--------------------------------------------------------------------- 
    104104 
    105 !------------------------------------------------------------------------------| 
    106 ! 1) Constant salinity, constant in time                                       | 
    107 !------------------------------------------------------------------------------| 
     105      !------------------------------------------------------------------------------| 
     106      ! 1) Constant salinity, constant in time                                       | 
     107      !------------------------------------------------------------------------------| 
    108108 
    109109      IF (num_sal.eq.1) THEN 
    110110 
    111          WRITE(numout,*) 
    112          WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 
    113          num_sal 
    114          WRITE(numout,*) '~~~~~~~~~~~~' 
     111         !         WRITE(numout,*) 
     112         !         WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 
     113         !         num_sal 
     114         !         WRITE(numout,*) '~~~~~~~~~~~~' 
    115115 
    116116         DO jk = 1, nlay_i 
    … …  
    126126      ENDIF ! num_sal .EQ. 1 
    127127 
    128 !------------------------------------------------------------------------------| 
    129 !  Module 2 : Constant salinity varying in time                                | 
    130 !------------------------------------------------------------------------------| 
     128      !------------------------------------------------------------------------------| 
     129      !  Module 2 : Constant salinity varying in time                                | 
     130      !------------------------------------------------------------------------------| 
    131131 
    132132      IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN 
    133133 
    134          WRITE(numout,*) 
    135          WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 
    136          num_sal 
    137          WRITE(numout,*) '~~~~~~~~~~~' 
    138          WRITE(numout,*) 
     134         !         WRITE(numout,*) 
     135         !         WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 
     136         !         num_sal 
     137         !         WRITE(numout,*) '~~~~~~~~~~~' 
     138         !         WRITE(numout,*) 
    139139 
    140140         !--------------------------------- 
    … …  
    143143         DO ji = kideb, kiut 
    144144            zhiold(ji)   =  ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) -     & 
    145                             dh_i_surf(ji) 
     145               dh_i_surf(ji) 
    146146         END DO ! ji 
    147147 
    … …  
    172172            i_ice_switch = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_i_b(ji) + 1.0e-2 ) ) 
    173173            isnowic      = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - dh_snowice(ji) ) ) * & 
    174                            i_ice_switch 
     174               i_ice_switch 
    175175 
    176176            !--------------------- 
    … …  
    180180            ! drainage by gravity drainage 
    181181            dsm_i_gd_1d(ji) = - igravdr *                                     &  
    182                                 MAX( sm_i_b(ji) - sal_G , 0.0 ) /             & 
    183                                 time_G * rdt_ice  
     182               MAX( sm_i_b(ji) - sal_G , 0.0 ) /             & 
     183               time_G * rdt_ice  
    184184 
    185185            ! drainage by flushing   
    186186            dsm_i_fl_1d(ji)  = - iflush *                                     & 
    187                                 MAX( sm_i_b(ji) - sal_F , 0.0 ) /             &  
    188                                 time_F * rdt_ice 
     187               MAX( sm_i_b(ji) - sal_F , 0.0 ) /             &  
     188               time_F * rdt_ice 
    189189 
    190190            !----------------- 
    … …  
    197197            zsiold(ji) = sm_i_b(ji) 
    198198            sm_i_b(ji) = sm_i_b(ji)                                           & 
    199                        + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji)  !                 & 
     199               + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji)  !                 & 
    200200 
    201201            ! if no ice, salinity eq 0.1 
    202202            i_ice_switch  = 1.0 - MAX ( 0.0, SIGN (1.0 , - ht_i_b(ji) ) ) 
    203203            sm_i_b(ji)    = i_ice_switch*sm_i_b(ji) + s_i_min * ( 1.0 -       & 
    204                             i_ice_switch ) 
     204               i_ice_switch ) 
    205205         END DO ! ji 
    206206 
    … …  
    229229            i_ice_switch  = 1.0 - MAX ( 0.0, SIGN (1.0 , - ht_i_b(ji) ) ) 
    230230            fsbri_1d(ji) = fsbri_1d(ji) -  & 
    231                            i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) *  & 
    232                            ( MAX(dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji), & 
    233                              sm_i_b(ji) - zsiold(ji) ) ) / rdt_ice 
     231               i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) *  & 
     232               ( MAX(dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji), & 
     233               sm_i_b(ji) - zsiold(ji) ) ) / rdt_ice 
    234234            IF ( num_sal .EQ. 4 ) fsbri_1d(ji) = 0.0 
    235235 
    … …  
    248248               zaaa         =  cpic 
    249249               zbbb         =  ( rcp - cpic ) * ( ztmelts - rtt ) + & 
    250                                q_i_b(ji,jk) / rhoic - lfus 
     250                  q_i_b(ji,jk) / rhoic - lfus 
    251251               zccc         =  lfus * ( ztmelts - rtt ) 
    252252               zdiscrim     =  SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) ) 
    253253               t_i_b(ji,jk) =  rtt - ( zbbb + zdiscrim ) / &  
    254                                      ( 2.0 *zaaa ) 
     254                  ( 2.0 *zaaa ) 
    255255            END DO !ji 
    256256 
    … …  
    259259      ENDIF ! num_sal .EQ. 2 
    260260 
    261 !------------------------------------------------------------------------------| 
    262 !  Module 3 : Profile of salinity, constant in time                            | 
    263 !------------------------------------------------------------------------------| 
     261      !------------------------------------------------------------------------------| 
     262      !  Module 3 : Profile of salinity, constant in time                            | 
     263      !------------------------------------------------------------------------------| 
    264264 
    265265      IF ( num_sal .EQ. 3 ) THEN 
    … …  
    267267         WRITE(numout,*) 
    268268         WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 
    269          num_sal 
     269            num_sal 
    270270         WRITE(numout,*) '~~~~~~~~~~~~' 
    271271 
    … …  
    274274      ENDIF ! num_sal .EQ. 3 
    275275 
    276 !------------------------------------------------------------------------------| 
    277 !  Module 4 : Constant salinity varying in time                                | 
    278 !------------------------------------------------------------------------------| 
     276      !------------------------------------------------------------------------------| 
     277      !  Module 4 : Constant salinity varying in time                                | 
     278      !------------------------------------------------------------------------------| 
    279279 
    280280      ! Cox and Weeks, 1974 
    … …  
    283283         WRITE(numout,*) 
    284284         WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 
    285          num_sal 
     285            num_sal 
    286286         WRITE(numout,*) '~~~~~~~~~~~~' 
    287287 
    … …  
    296296               sm_i_b(ji)    = MIN(sm_i_b(ji),zsold)   
    297297            ENDIF 
    298           
     298 
    299299            IF ( ht_i_b(ji) .GT. 3.06918239 ) THEN  
    300300               sm_i_b(ji)     = 3.0 
    … …  
    304304               s_i_b(ji,jk)   = sm_i_b(ji) 
    305305            END DO 
    306        
     306 
    307307         END DO ! ji 
    308308 
    309309      ENDIF ! num_sal 
    310310 
    311 !------------------------------------------------------------------------------| 
    312 ! 5) Computation of salt flux due to Bottom growth 
    313 !------------------------------------------------------------------------------| 
     311      !------------------------------------------------------------------------------| 
     312      ! 5) Computation of salt flux due to Bottom growth 
     313      !------------------------------------------------------------------------------| 
    314314 
    315315      IF ( num_sal .EQ. 4 ) THEN 
    … …  
    318318            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    319319            fseqv_1d(ji) = fseqv_1d(ji)              + &  
    320                            ( sss_m(zji,zjj) - bulk_sal    ) * &  
    321                            rhoic * a_i_b(ji) * & 
    322                            MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 
     320               ( sss_m(zji,zjj) - bulk_sal    ) * &  
     321               rhoic * a_i_b(ji) * & 
     322               MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 
    323323         END DO 
    324324      ELSE 
    … …  
    327327            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    328328            fseqv_1d(ji) = fseqv_1d(ji)              + &  
    329                            ( sss_m(zji,zjj) - s_i_new(ji) ) * &  
    330                              rhoic * a_i_b(ji) * & 
    331                              MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 
     329               ( sss_m(zji,zjj) - s_i_new(ji) ) * &  
     330               rhoic * a_i_b(ji) * & 
     331               MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 
    332332         END DO ! ji 
    333333      ENDIF 
    334334 
    335 !-- End of salinity computations 
     335      !-- End of salinity computations 
    336336   END SUBROUTINE lim_thd_sal 
    337 !============================================================================== 
     337   !============================================================================== 
    338338 
    339339   SUBROUTINE lim_thd_sal_init 
    … …  
    352352      !!------------------------------------------------------------------- 
    353353      NAMELIST/namicesal/ num_sal, bulk_sal, sal_G, time_G, sal_F, time_F, & 
    354                           s_i_max, s_i_min, s_i_0, s_i_1 
     354         s_i_max, s_i_min, s_i_0, s_i_1 
    355355      !!------------------------------------------------------------------- 
    356356 

  • trunk/NEMO/LIM_SRC_3/limtrp.F90

    r888 r921  
    5757CONTAINS 
    5858 
    59    SUBROUTINE lim_trp 
     59   SUBROUTINE lim_trp( kt )  
    6060      !!------------------------------------------------------------------- 
    6161      !!                   ***  ROUTINE lim_trp *** 
    … …  
    7575      !!   3.0  !  05-11 (M. Vancoppenolle)   Multi-layer sea ice, salinity variations 
    7676      !!--------------------------------------------------------------------- 
     77      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    7778      !! * Local Variables 
    7879      INTEGER  ::   ji, jj, jk, jl, layer, &  ! dummy loop indices 
    79                     initad           ! number of sub-timestep for the advection 
     80         initad           ! number of sub-timestep for the advection 
    8081      INTEGER  ::   ji_maxu, ji_maxv, jj_maxu, jj_maxv 
    8182 
    … …  
    102103         zs0sm , zs0oi 
    103104 
    104 ! MHE Multilayer heat content 
     105      ! MHE Multilayer heat content 
    105106      REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl)  ::   &  ! temporary workspace 
    106107         zs0e 
    … …  
    111112 
    112113      zsm(:,:) = area(:,:) 
    113        
    114       IF( ln_limdyn ) THEN 
    115          WRITE(numout,*) 
    116          WRITE(numout,*) ' lim_trp : Ice Advection' 
    117          WRITE(numout,*) ' ~~~~~~~' 
    118  
    119 !-----------------------------------------------------------------------------! 
    120 ! 1) CFL Test                                                              
    121 !-----------------------------------------------------------------------------! 
     114 
     115      IF( ln_limdyn .AND. lwp ) THEN 
     116         IF( kt == nit000 ) THEN 
     117            WRITE(numout,*) ' lim_trp : Ice Advection' 
     118            WRITE(numout,*) ' ~~~~~~~' 
     119         ENDIF 
     120 
     121         !-----------------------------------------------------------------------------! 
     122         ! 1) CFL Test                                                              
     123         !-----------------------------------------------------------------------------! 
    122124 
    123125         !------------------------------------------ 
    124126         ! ice velocities at ocean U- and V-points  
    125127         !------------------------------------------ 
    126           
     128 
    127129         ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions.         
    128130         zvbord = 1.0 + ( 1.0 - bound ) 
    … …  
    166168 
    167169         IF ( zcfl > 0.5 .AND. lwp ) & 
    168          WRITE(numout,*) 'lim_trp : violation of cfl criterion the ',nday,'th day, cfl = ',zcfl 
    169  
    170 !-----------------------------------------------------------------------------! 
    171 ! 2) Computation of transported fields                                         
    172 !-----------------------------------------------------------------------------! 
     170            WRITE(numout,*) 'lim_trp : violation of cfl criterion the ',nday,'th day, cfl = ',zcfl 
     171 
     172         !-----------------------------------------------------------------------------! 
     173         ! 2) Computation of transported fields                                         
     174         !-----------------------------------------------------------------------------! 
    173175 
    174176         !------------------------------------------------------ 
    … …  
    185187            zs0oi (:,:,jl) =  oa_i (:,:,jl)  * area(:,:)    ! Age content 
    186188 
    187          !---------------------------------- 
    188          ! 1.2) Ice and snow heat contents 
    189          !---------------------------------- 
     189            !---------------------------------- 
     190            ! 1.2) Ice and snow heat contents 
     191            !---------------------------------- 
    190192 
    191193            zs0c0 (:,:,jl)     = e_s(:,:,1,jl)              ! Snow heat cont. 
    … …  
    195197         END DO 
    196198 
    197 !-----------------------------------------------------------------------------! 
    198 ! 3) Advection of Ice fields                                               
    199 !-----------------------------------------------------------------------------! 
     199         !-----------------------------------------------------------------------------! 
     200         ! 3) Advection of Ice fields                                               
     201         !-----------------------------------------------------------------------------! 
    200202 
    201203         ! If ice drift field is too fast, use an appropriate time step for advection.          
    202204         initad = 1 + INT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 
    203205         zusnit = 1.0 / REAL( initad )  
    204           
     206 
    205207         IF ( MOD( nday , 2 ) == 0) THEN 
    206208            DO jk = 1,initad 
    207209               !--- ice open water area 
    208210               CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0ow(:,:) , sxopw(:,:) , &  
    209                                                           sxxopw(:,:), syopw(:,:) , &  
    210                                                           syyopw(:,:), sxopw(:,:) ) 
     211                  sxxopw(:,:), syopw(:,:) , &  
     212                  syyopw(:,:), sxopw(:,:) ) 
    211213               CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0ow(:,:) , sxopw (:,:) , & 
    212                                                           sxxopw(:,:), syopw (:,:) , &  
    213                                                           syyopw(:,:), sxyopw(:,:) ) 
     214                  sxxopw(:,:), syopw (:,:) , &  
     215                  syyopw(:,:), sxyopw(:,:) ) 
    214216               DO jl = 1, jpl 
    215217                  !--- ice volume  --- 
    216218                  CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0ice(:,:,jl) , sxice (:,:,jl) , &  
    217                                                              sxxice(:,:,jl) , syice (:,:,jl) , &  
    218                                                              syyice(:,:,jl) , sxyice(:,:,jl) ) 
     219                     sxxice(:,:,jl) , syice (:,:,jl) , &  
     220                     syyice(:,:,jl) , sxyice(:,:,jl) ) 
    219221                  CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0ice(:,:,jl) , sxice (:,:,jl) , & 
    220                                                              sxxice(:,:,jl) , syice (:,:,jl) , &  
    221                                                              syyice(:,:,jl) , sxyice(:,:,jl) ) 
     222                     sxxice(:,:,jl) , syice (:,:,jl) , &  
     223                     syyice(:,:,jl) , sxyice(:,:,jl) ) 
    222224                  !--- snow volume  --- 
    223225                  CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0sn (:,:,jl) , sxsn  (:,:,jl) , & 
    224                                                              sxxsn (:,:,jl) , sysn  (:,:,jl) , & 
    225                                                              syysn (:,:,jl) , sxysn (:,:,jl) ) 
     226                     sxxsn (:,:,jl) , sysn  (:,:,jl) , & 
     227                     syysn (:,:,jl) , sxysn (:,:,jl) ) 
    226228                  CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0sn (:,:,jl) , sxsn  (:,:,jl) , & 
    227                                                              sxxsn (:,:,jl) , sysn  (:,:,jl) , & 
    228                                                              syysn (:,:,jl) , sxysn (:,:,jl) ) 
     229                     sxxsn (:,:,jl) , sysn  (:,:,jl) , & 
     230                     syysn (:,:,jl) , sxysn (:,:,jl) ) 
    229231                  !--- ice salinity --- 
    230232                  CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0sm (:,:,jl) , sxsal (:,:,jl) , & 
    231                                                              sxxsal(:,:,jl) , sysal (:,:,jl) , & 
    232                                                              syysal(:,:,jl) , sxysal(:,:,jl)  ) 
     233                     sxxsal(:,:,jl) , sysal (:,:,jl) , & 
     234                     syysal(:,:,jl) , sxysal(:,:,jl)  ) 
    233235                  CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0sm (:,:,jl) , sxsal (:,:,jl) , & 
    234                                                              sxxsal(:,:,jl) , sysal (:,:,jl) , & 
    235                                                              syysal(:,:,jl) , sxysal(:,:,jl)  ) 
     236                     sxxsal(:,:,jl) , sysal (:,:,jl) , & 
     237                     syysal(:,:,jl) , sxysal(:,:,jl)  ) 
    236238                  !--- ice age      ---      
    237239                  CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0oi (:,:,jl) , sxage (:,:,jl) , & 
    238                                                              sxxage(:,:,jl) , syage (:,:,jl) , & 
    239                                                              syyage(:,:,jl) , sxyage(:,:,jl)  ) 
     240                     sxxage(:,:,jl) , syage (:,:,jl) , & 
     241                     syyage(:,:,jl) , sxyage(:,:,jl)  ) 
    240242                  CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0oi (:,:,jl) , sxage (:,:,jl) , & 
    241                                                              sxxage(:,:,jl) , syage (:,:,jl) , & 
    242                                                              syyage(:,:,jl) , sxyage(:,:,jl)  ) 
     243                     sxxage(:,:,jl) , syage (:,:,jl) , & 
     244                     syyage(:,:,jl) , sxyage(:,:,jl)  ) 
    243245                  !--- ice concentrations --- 
    244246                  CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0a  (:,:,jl) , sxa   (:,:,jl) , & 
    245                                                              sxxa  (:,:,jl) , sya   (:,:,jl) , &  
    246                                                              syya  (:,:,jl) , sxya  (:,:,jl)  ) 
     247                     sxxa  (:,:,jl) , sya   (:,:,jl) , &  
     248                     syya  (:,:,jl) , sxya  (:,:,jl)  ) 
    247249                  CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0a  (:,:,jl) , sxa   (:,:,jl) , &  
    248                                                              sxxa  (:,:,jl) , sya   (:,:,jl) , &  
    249                                                              syya  (:,:,jl) , sxya  (:,:,jl)  ) 
     250                     sxxa  (:,:,jl) , sya   (:,:,jl) , &  
     251                     syya  (:,:,jl) , sxya  (:,:,jl)  ) 
    250252                  !--- ice / snow thermal energetic contents --- 
    251253                  CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0c0 (:,:,jl) , sxc0  (:,:,jl) , &  
    252                                                              sxxc0 (:,:,jl) , syc0  (:,:,jl) , & 
    253                                                              syyc0 (:,:,jl) , sxyc0 (:,:,jl)  ) 
     254                     sxxc0 (:,:,jl) , syc0  (:,:,jl) , & 
     255                     syyc0 (:,:,jl) , sxyc0 (:,:,jl)  ) 
    254256                  CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0c0 (:,:,jl) , sxc0  (:,:,jl) , & 
    255                                                              sxxc0 (:,:,jl) , syc0  (:,:,jl) , & 
    256                                                              syyc0 (:,:,jl) , sxyc0 (:,:,jl)  ) 
     257                     sxxc0 (:,:,jl) , syc0  (:,:,jl) , & 
     258                     syyc0 (:,:,jl) , sxyc0 (:,:,jl)  ) 
    257259                  DO layer = 1, nlay_i 
    258260                     CALL lim_adv_x( zusnit, zui_u, rone , zsm, & 
    259                                                              zs0e(:,:,layer,jl) , sxe (:,:,layer,jl) , &  
    260                                                              sxxe(:,:,layer,jl) , sye (:,:,layer,jl) , & 
    261                                                              syye(:,:,layer,jl) , sxye(:,:,layer,jl) ) 
     261                        zs0e(:,:,layer,jl) , sxe (:,:,layer,jl) , &  
     262                        sxxe(:,:,layer,jl) , sye (:,:,layer,jl) , & 
     263                        syye(:,:,layer,jl) , sxye(:,:,layer,jl) ) 
    262264                     CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, &  
    263                                                              zs0e(:,:,layer,jl) , sxe (:,:,layer,jl) , &  
    264                                                              sxxe(:,:,layer,jl) , sye (:,:,layer,jl) , & 
    265                                                              syye(:,:,layer,jl) , sxye(:,:,layer,jl) ) 
     265                        zs0e(:,:,layer,jl) , sxe (:,:,layer,jl) , &  
     266                        sxxe(:,:,layer,jl) , sye (:,:,layer,jl) , & 
     267                        syye(:,:,layer,jl) , sxye(:,:,layer,jl) ) 
    266268                  END DO 
    267269               END DO 
    … …  
    271273               !--- ice volume  --- 
    272274               CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0ow (:,:) , sxopw (:,:) , & 
    273                                                           sxxopw(:,:) , syopw (:,:) , &  
    274                                                           syyopw(:,:) , sxyopw(:,:) ) 
     275                  sxxopw(:,:) , syopw (:,:) , &  
     276                  syyopw(:,:) , sxyopw(:,:) ) 
    275277               CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0ow (:,:) , sxopw (:,:) , &  
    276                                                           sxxopw(:,:) , syopw (:,:) , & 
    277                                                           syyopw(:,:) , sxyopw(:,:) ) 
     278                  sxxopw(:,:) , syopw (:,:) , & 
     279                  syyopw(:,:) , sxyopw(:,:) ) 
    278280               DO jl = 1, jpl 
    279281                  !--- ice volume  --- 
    280282                  CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0ice(:,:,jl) , sxice (:,:,jl) , & 
    281                                                              sxxice(:,:,jl) , syice (:,:,jl) , &  
    282                                                              syyice(:,:,jl) , sxyice(:,:,jl) ) 
     283                     sxxice(:,:,jl) , syice (:,:,jl) , &  
     284                     syyice(:,:,jl) , sxyice(:,:,jl) ) 
    283285                  CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0ice(:,:,jl) , sxice (:,:,jl) , &  
    284                                                              sxxice(:,:,jl) , syice (:,:,jl) , & 
    285                                                              syyice(:,:,jl) , sxyice(:,:,jl) ) 
     286                     sxxice(:,:,jl) , syice (:,:,jl) , & 
     287                     syyice(:,:,jl) , sxyice(:,:,jl) ) 
    286288                  !--- snow volume  --- 
    287289                  CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0sn (:,:,jl) , sxsn  (:,:,jl) , &  
    288                                                              sxxsn (:,:,jl) , sysn  (:,:,jl) , &  
    289                                                              syysn (:,:,jl) , sxysn (:,:,jl) ) 
     290                     sxxsn (:,:,jl) , sysn  (:,:,jl) , &  
     291                     syysn (:,:,jl) , sxysn (:,:,jl) ) 
    290292                  CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0sn (:,:,jl) , sxsn  (:,:,jl) , &  
    291                                                              sxxsn (:,:,jl) , sysn  (:,:,jl) , &  
    292                                                              syysn (:,:,jl) , sxysn (:,:,jl) ) 
     293                     sxxsn (:,:,jl) , sysn  (:,:,jl) , &  
     294                     syysn (:,:,jl) , sxysn (:,:,jl) ) 
    293295                  !--- ice salinity --- 
    294296                  CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0sm (:,:,jl) , sxsal (:,:,jl) , & 
    295                                                              sxxsal(:,:,jl) , sysal (:,:,jl) , & 
    296                                                              syysal(:,:,jl) , sxysal(:,:,jl) ) 
     297                     sxxsal(:,:,jl) , sysal (:,:,jl) , & 
     298                     syysal(:,:,jl) , sxysal(:,:,jl) ) 
    297299                  CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0sm (:,:,jl) , sxsal (:,:,jl) , & 
    298                                                              sxxsal(:,:,jl) , sysal (:,:,jl) , & 
    299                                                              syysal(:,:,jl) , sxysal(:,:,jl) ) 
     300                     sxxsal(:,:,jl) , sysal (:,:,jl) , & 
     301                     syysal(:,:,jl) , sxysal(:,:,jl) ) 
    300302                  !--- ice age      --- 
    301303                  CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0oi (:,:,jl) , sxage (:,:,jl) , & 
    302                                                              sxxage(:,:,jl) , syage (:,:,jl) , &  
    303                                                              syyage(:,:,jl) , sxyage(:,:,jl)  ) 
     304                     sxxage(:,:,jl) , syage (:,:,jl) , &  
     305                     syyage(:,:,jl) , sxyage(:,:,jl)  ) 
    304306                  CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0oi (:,:,jl) , sxage (:,:,jl) , & 
    305                                                              sxxage(:,:,jl) , syage (:,:,jl) , & 
    306                                                              syyage(:,:,jl) , sxyage(:,:,jl)   ) 
     307                     sxxage(:,:,jl) , syage (:,:,jl) , & 
     308                     syyage(:,:,jl) , sxyage(:,:,jl)   ) 
    307309                  !--- ice concentration --- 
    308310                  CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0a  (:,:,jl) , sxa   (:,:,jl) , &  
    309                                                              sxxa  (:,:,jl) , sya   (:,:,jl) , &  
    310                                                              syya  (:,:,jl) , sxya  (:,:,jl)  ) 
     311                     sxxa  (:,:,jl) , sya   (:,:,jl) , &  
     312                     syya  (:,:,jl) , sxya  (:,:,jl)  ) 
    311313                  CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0a  (:,:,jl) , sxa   (:,:,jl) , &  
    312                                                              sxxa  (:,:,jl) , sya   (:,:,jl) , &  
    313                                                              syya  (:,:,jl) , sxya  (:,:,jl)  ) 
     314                     sxxa  (:,:,jl) , sya   (:,:,jl) , &  
     315                     syya  (:,:,jl) , sxya  (:,:,jl)  ) 
    314316                  !--- ice / snow thermal energetic contents --- 
    315317                  CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0c0 (:,:,jl) , sxc0  (:,:,jl) , &  
    316                                                              sxxc0 (:,:,jl) , syc0  (:,:,jl) , & 
    317                                                              syyc0 (:,:,jl) , sxyc0 (:,:,jl)  ) 
     318                     sxxc0 (:,:,jl) , syc0  (:,:,jl) , & 
     319                     syyc0 (:,:,jl) , sxyc0 (:,:,jl)  ) 
    318320                  CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0c0 (:,:,jl) , sxc0  (:,:,jl) , & 
    319                                                              sxxc0 (:,:,jl) , syc0  (:,:,jl) , & 
    320                                                              syyc0 (:,:,jl) , sxyc0 (:,:,jl)  ) 
     321                     sxxc0 (:,:,jl) , syc0  (:,:,jl) , & 
     322                     syyc0 (:,:,jl) , sxyc0 (:,:,jl)  ) 
    321323                  DO layer = 1, nlay_i 
    322324                     CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0e(:,:,layer,jl) , & 
    323                                      sxe (:,:,layer,jl) , sxxe (:,:,layer,jl) , sye (:,:,layer,jl) , & 
    324                                      syye (:,:,layer,jl), sxye (:,:,layer,jl) ) 
     325                        sxe (:,:,layer,jl) , sxxe (:,:,layer,jl) , sye (:,:,layer,jl) , & 
     326                        syye (:,:,layer,jl), sxye (:,:,layer,jl) ) 
    325327                     CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0e(:,:,layer,jl) , & 
    326                                      sxe (:,:,layer,jl) , sxxe (:,:,layer,jl) , sye (:,:,layer,jl) , & 
    327                                      syye (:,:,layer,jl), sxye (:,:,layer,jl)  ) 
     328                        sxe (:,:,layer,jl) , sxxe (:,:,layer,jl) , sye (:,:,layer,jl) , & 
     329                        syye (:,:,layer,jl), sxye (:,:,layer,jl)  ) 
    328330                  END DO 
    329331 
    … …  
    349351         END DO 
    350352 
    351 !------------------------------------------------------------------------------! 
    352 ! 4) Diffusion of Ice fields                   
    353 !------------------------------------------------------------------------------! 
    354  
    355       !------------------------------------ 
    356       ! 4.1) diffusion of open water area 
    357       !------------------------------------ 
     353         !------------------------------------------------------------------------------! 
     354         ! 4) Diffusion of Ice fields                   
     355         !------------------------------------------------------------------------------! 
     356 
     357         !------------------------------------ 
     358         ! 4.1) diffusion of open water area 
     359         !------------------------------------ 
    358360 
    359361         ! Compute total ice fraction 
    … …  
    364366                  zs0at (ji,jj) = zs0at(ji,jj) + zs0a(ji,jj,jl) ! 
    365367               END DO 
    366             END DO  
     368            END DO 
    367369         END DO 
    368370 
    … …  
    380382         CALL lim_hdf( zs0ow (:,:) ) 
    381383 
    382       !---------------------------------------- 
    383       ! 4.2) Diffusion of other ice variables 
    384       !---------------------------------------- 
    385          DO jl = 1, jpl 
    386  
    387          ! Masked eddy diffusivity coefficient at ocean U- and V-points 
     384         !---------------------------------------- 
     385         ! 4.2) Diffusion of other ice variables 
     386         !---------------------------------------- 
     387         DO jl = 1, jpl 
     388 
     389            ! Masked eddy diffusivity coefficient at ocean U- and V-points 
    388390            DO jj = 1, jpjm1          ! NB: has not to be defined on jpj line and jpi row 
    389391               DO ji = 1 , fs_jpim1   ! vector opt. 
    … …  
    406408         END DO !jl 
    407409 
    408       !----------------------------------------- 
    409       ! 4.3) Remultiply everything by ice area 
    410       !----------------------------------------- 
     410         !----------------------------------------- 
     411         ! 4.3) Remultiply everything by ice area 
     412         !----------------------------------------- 
    411413         zs0ow(:,:) = MAX(rzero, zs0ow(:,:) * area(:,:) ) 
    412414         DO jl = 1, jpl 
    … …  
    422424         END DO ! jl 
    423425 
    424 !------------------------------------------------------------------------------! 
    425 ! 5) Update and limit ice properties after transport                            
    426 !------------------------------------------------------------------------------! 
    427  
    428       !-------------------------------------------------- 
    429       ! 5.1) Recover mean values over the grid squares. 
    430       !-------------------------------------------------- 
     426         !------------------------------------------------------------------------------! 
     427         ! 5) Update and limit ice properties after transport                            
     428         !------------------------------------------------------------------------------! 
     429 
     430         !-------------------------------------------------- 
     431         ! 5.1) Recover mean values over the grid squares. 
     432         !-------------------------------------------------- 
    431433 
    432434         DO jl = 1, jpl 
    … …  
    435437                  DO ji = 1, jpi 
    436438                     zs0e (ji,jj,jk,jl) =  & 
    437                      MAX( rzero, zs0e (ji,jj,jk,jl) / area(ji,jj) ) 
     439                        MAX( rzero, zs0e (ji,jj,jk,jl) / area(ji,jj) ) 
    438440                  END DO 
    439441               END DO 
    … …  
    446448            END DO 
    447449         END DO 
    448           
     450 
    449451         zs0at(:,:) = 0.0 
    450452         DO jl = 1, jpl 
    … …  
    462464         END DO 
    463465 
    464       !--------------------------------------------------------- 
    465       ! 5.2) Snow thickness, Ice thickness, Ice concentrations 
    466       !--------------------------------------------------------- 
     466         !--------------------------------------------------------- 
     467         ! 5.2) Snow thickness, Ice thickness, Ice concentrations 
     468         !--------------------------------------------------------- 
    467469 
    468470         DO jj = 1, jpj 
    … …  
    501503         END DO 
    502504 
    503       !---------------------- 
    504       ! 5.3) Ice properties 
    505       !---------------------- 
     505         !---------------------- 
     506         ! 5.3) Ice properties 
     507         !---------------------- 
    506508 
    507509         zbigval         =  1.0d+13 
    … …  
    521523                  ! Ice salinity and age 
    522524                  zsal            = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj)  , & 
    523                                             zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * & 
    524                                             v_i(ji,jj,jl) 
     525                     zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * & 
     526                     v_i(ji,jj,jl) 
    525527                  IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) &  
    526528                     smv_i(ji,jj,jl) = zindic*zsal + (1.0-zindic)*0.0 
    527529 
    528530                  zage            = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / &  
    529                                               MAX( a_i(ji,jj,jl), epsi16 )  ), 0.0 ) * & 
    530                                               a_i(ji,jj,jl) 
     531                     MAX( a_i(ji,jj,jl), epsi16 )  ), 0.0 ) * & 
     532                     a_i(ji,jj,jl) 
    531533                  oa_i (ji,jj,jl)  = zindic*zage  
    532534 
    … …  
    616618         WRITE(numout,*)  
    617619      ENDIF 
    618              
     620 
    619621   END SUBROUTINE lim_trp_init 
    620622 

  • trunk/NEMO/LIM_SRC_3/limupdate.F90

    r895 r921  
    8282      !! * Local variables 
    8383      INTEGER ::      & 
    84           ji, jj,     & ! geographical indices 
    85           jk, jl, jm    ! layer, category and type indices 
     84         ji, jj,     & ! geographical indices 
     85         jk, jl, jm    ! layer, category and type indices 
    8686      INTEGER ::      & 
    87           jbnd1, jbnd2 
     87         jbnd1, jbnd2 
    8888      INTEGER ::      & 
    89           i_ice_switch 
     89         i_ice_switch 
    9090 
    9191      REAL(wp)  ::           &  ! constant values 
    … …  
    9999         rone   = 1.e0    ,  & 
    100100         zhimax                   ! maximum thickness tolerated for advection of 
    101                                   ! in an ice-free cell 
     101      ! in an ice-free cell 
    102102      REAL(wp) ::            &  ! dummy switches and arguments 
    103103         zindb, zindsn, zindic, zacrith,  & 
    … …  
    116116      REAL(wp), DIMENSION(jkmax) :: & 
    117117         zthick0, zqm0      ! thickness of the layers and heat contents for 
    118                             ! internal melt 
     118      ! internal melt 
    119119      REAL(wp) ::                   & 
    120120         zweight, zesum 
    121          
     121 
    122122 
    123123      !!------------------------------------------------------------------- 
    124124 
    125       WRITE(numout,*) ' lim_update ' 
    126       WRITE(numout,*) ' ~~~~~~~~~~ ' 
    127  
    128 !+++++ [ 
    129         WRITE(numout,*) ' O) Initial values ' 
    130         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    131         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
    132         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    133         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    134         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    135         DO jk = 1, nlay_i 
    136         WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    137         END DO 
    138 !+++++ ] 
    139  
    140 !------------------------------------------------------------------------------ 
    141 ! 1. Update of Global variables                                               | 
    142 !------------------------------------------------------------------------------ 
    143  
    144      !--------------------- 
    145      ! Ice dynamics   
    146      !--------------------- 
    147  
    148      u_ice(:,:) = u_ice(:,:) + d_u_ice_dyn(:,:) 
    149      v_ice(:,:) = v_ice(:,:) + d_v_ice_dyn(:,:) 
    150  
    151      !----------------------------- 
    152      ! Update ice and snow volumes   
    153      !----------------------------- 
    154  
    155      DO jl = 1, jpl 
    156         DO jj = 1, jpj 
    157            DO ji = 1, jpi 
    158  
    159               v_i(ji,jj,jl)  = v_i(ji,jj,jl) + d_v_i_trp(ji,jj,jl)  & 
    160                                              + d_v_i_thd(ji,jj,jl)  
    161               v_s(ji,jj,jl)  = v_s(ji,jj,jl) + d_v_s_trp(ji,jj,jl)  & 
    162                                              + d_v_s_thd(ji,jj,jl) 
    163            END DO 
    164         END DO 
    165      END DO 
    166  
    167      !--------------------------------- 
    168      ! Classify the pathological cases 
    169      !--------------------------------- 
    170      ! (1) v_i (new) > 0; d_v_i_thd + v_i(old) > 0 (easy case) 
    171      ! (2) v_i (new) > 0; d_v_i_thd + v_i(old) = 0 (total thermodynamic ablation) 
    172      ! (3) v_i (new) < 0; d_v_i_thd + v_i(old) > 0 (combined total ablation) 
    173      ! (4) v_i (new) < 0; d_v_i_thd + v_i(old) = 0 (total thermodynamic ablation  
    174      ! with negative advection, very pathological ) 
    175      ! (5) v_i (old) = 0; d_v_i_trp > 0 (advection of ice in a free-cell) 
    176  
    177      DO jl = 1, jpl 
    178         DO jj = 1, jpj 
    179            DO ji = 1, jpi 
    180               patho_case(ji,jj,jl) = 1 
    181               IF ( v_i(ji,jj,jl) .GE. 0.0 ) THEN 
    182                  IF ( old_v_i(ji,jj,jl) + d_v_i_thd(ji,jj,jl) .LT. epsi10 ) THEN  
    183                     patho_case(ji,jj,jl) = 2 
    184                  ENDIF 
    185               ELSE 
    186                  patho_case(ji,jj,jl) = 3 
    187                  IF ( old_v_i(ji,jj,jl) + d_v_i_thd(ji,jj,jl) .LT. epsi10 ) THEN  
    188                     patho_case(ji,jj,jl) = 4 
    189                  ENDIF 
    190               ENDIF 
    191               IF ( ( old_v_i(ji,jj,jl) .LE. epsi10 ) .AND. & 
    192                    ( d_v_i_trp(ji,jj,jl) .GT. epsi06 ) ) THEN 
    193                  patho_case(ji,jj,jl) = 5 ! advection of ice in an ice-free 
    194                                              ! cell 
    195                  WRITE(numout,*) ' ALERTE patho_case still equal to 5 ' 
    196                  WRITE(numout,*) ' ji , jj   : ', ji, jj 
    197                  WRITE(numout,*) ' old_v_i   : ', old_v_i(ji,jj,jl) 
    198                  WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) 
    199  
    200               ENDIF 
    201            END DO 
    202         END DO 
    203      END DO 
    204  
    205      !-------------------- 
    206      ! Excessive ablation  
    207      !-------------------- 
    208  
    209      DO jl = 1, jpl 
    210         DO jj = 1, jpj 
    211            DO ji = 1, jpi 
    212               IF (      ( patho_case(ji,jj,jl) .EQ. 3 ) & 
    213                    .OR. ( patho_case(ji,jj,jl) .EQ. 4 ) ) THEN 
    214               zviold         = old_v_i(ji,jj,jl) 
    215               zvsold         = old_v_s(ji,jj,jl) 
    216               ! in cases 3 ( combined total ablation ) 
    217               !      and 4 ( total ablation with negative advection ) 
    218               ! there is excessive total ablation 
    219               ! advection is chosen to be prioritary in order to conserve mass.  
    220               ! dv_i_thd is computed as a residual 
    221               ! negative energy has to be kept in memory and to be given to the ocean 
    222               ! equivalent salt flux is given to the ocean 
    223               ! 
    224               ! This was the best solution found. Otherwise, mass conservation in advection 
    225               ! scheme should have been revised, which could have been a big problem 
    226               ! Martin Vancoppenolle (2006, updated 2007) 
    227  
    228               ! is there any ice left ? 
    229               zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
    230               !=1 if hi > 1e-3 and 0 if not 
    231               zdvres        = MAX(0.0,-v_i(ji,jj,jl)) !residual volume if too much ice was molten 
    232                                                       !this quantity is positive 
    233               v_i(ji,jj,jl) = zindic*v_i(ji,jj,jl)    !ice volume cannot be negative 
    234                                  !correct thermodynamic ablation 
    235               d_v_i_thd(ji,jj,jl)  = zindic  *  d_v_i_thd(ji,jj,jl) + &  
    236                                 (1.0-zindic) * (-zviold - d_v_i_trp(ji,jj,jl))  
    237               ! THIS IS NEW 
    238               d_a_i_thd(ji,jj,jl)  = zindic  *  d_a_i_thd(ji,jj,jl) + &  
    239                                 (1.0-zindic) * (-old_a_i(ji,jj,jl))  
    240  
    241               !residual salt flux if ice is over-molten 
    242               fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * &  
    243                              ( rhoic * zdvres / rdt_ice ) 
    244 !             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhoic * lfus * zdvres / rdt_ice 
    245  
    246               ! is there any snow left ? 
    247               zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) )  
    248               zvsold        = v_s(ji,jj,jl) 
    249               zdvres        = MAX(0.0,-v_s(ji,jj,jl)) !residual volume if too much ice was molten 
    250                                                       !this quantity is positive 
    251               v_s(ji,jj,jl) = zindsn*v_s(ji,jj,jl)    !snow volume cannot be negative 
    252                                                       !correct thermodynamic ablation 
    253               d_v_s_thd(ji,jj,jl)  = zindsn  *  d_v_s_thd(ji,jj,jl) + &  
    254                                  (1.0-zindsn) * (-zvsold - d_v_s_trp(ji,jj,jl))  
    255               !unsure correction on salt flux.... maybe future will tell it was not that right 
    256  
    257               !residual salt flux if snow is over-molten 
    258               fsalt_res(ji,jj)  = fsalt_res(ji,jj) + sss_m(ji,jj) * &  
    259                              ( rhosn * zdvres / rdt_ice ) 
    260                              !this flux will be positive if snow was over-molten 
    261 !             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhosn * lfus * zdvres / rdt_ice 
    262               ENDIF 
    263            END DO !ji 
    264         END DO !jj 
    265      END DO !jl 
    266  
    267 !+++++ [ 
    268      DO jj = 1, jpj 
    269         DO ji = 1, jpi 
    270            IF ( ABS(fsalt_res(ji,jj)) .GT. 1.0 ) THEN  
    271               WRITE(numout,*) ' ALERTE 1000 : residual salt flux of -> ', & 
    272               fsalt_res(ji,jj) 
    273               WRITE(numout,*) ' ji, jj : ', ji, jj, ' gphit, glamt : ', & 
    274               gphit(ji,jj), glamt(ji,jj) 
    275            ENDIF 
    276         END DO 
    277      END DO 
    278  
    279      WRITE(numout,*) ' 1. Before update of Global variables ' 
    280      WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    281      WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
    282      WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    283         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    284      WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    285         DO jk = 1, nlay_i 
    286         WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    287         END DO 
    288 !+++++ ] 
    289  
    290      !--------------------------------------------- 
    291      ! Ice concentration and ice heat content 
    292      !--------------------------------------------- 
    293  
    294      a_i (:,:,:) = a_i (:,:,:)   + d_a_i_trp(:,:,:)     & 
    295                                  + d_a_i_thd(:,:,:) 
    296      CALL lim_var_glo2eqv ! useless, just for debug 
    297         DO jk = 1, nlay_i 
    298         WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
    299         END DO 
    300      e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_trp(:,:,:,:)   
    301      CALL lim_var_glo2eqv ! useless, just for debug 
    302         WRITE(numout,*) ' After transport update ' 
    303         DO jk = 1, nlay_i 
    304         WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
    305         END DO 
    306      e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_thd(:,:,:,:)   
    307      CALL lim_var_glo2eqv ! useless, just for debug 
    308         WRITE(numout,*) ' After thermodyn update ' 
    309         DO jk = 1, nlay_i 
    310         WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
    311         END DO 
    312  
    313      at_i(:,:) = 0.0 
    314      DO jl = 1, jpl 
    315         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    316      END DO 
    317  
    318 !+++++ [ 
    319      WRITE(numout,*) ' 1. After update of Global variables (2) ' 
    320      WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    321      WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
    322      WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    323         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    324      WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    325      WRITE(numout,*) ' oa_i : ', oa_i(jiindx, jjindx, 1:jpl) 
    326      WRITE(numout,*) ' e_s : ', e_s(jiindx, jjindx, 1, 1:jpl) 
    327         DO jk = 1, nlay_i 
    328         WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    329         END DO 
    330 !+++++ ] 
    331  
    332      !------------------------------ 
    333      ! Snow temperature and ice age 
    334      !------------------------------ 
    335  
    336      e_s(:,:,:,:) = e_s(:,:,:,:)        + & 
    337                     d_e_s_trp(:,:,:,:)  + & 
    338                     d_e_s_thd(:,:,:,:) 
    339  
    340      oa_i(:,:,:)  = oa_i(:,:,:)         + & 
    341                     d_oa_i_trp(:,:,:)   + & 
    342                     d_oa_i_thd(:,:,:) 
    343  
    344      !-------------- 
    345      ! Ice salinity     
    346      !-------------- 
    347  
    348      IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN ! general case 
    349  
    350 !+++++ 
    351      WRITE(numout,*) ' Before everything ' 
    352      WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    353      WRITE(numout,*) ' oa_i:  ', oa_i(jiindx, jjindx, 1:jpl) 
    354         DO jk = 1, nlay_i 
    355         WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    356         END DO 
    357         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    358 !+++++ 
    359  
    360      smv_i(:,:,:) = smv_i(:,:,:)       + & 
    361                     d_smv_i_thd(:,:,:) + & 
    362                     d_smv_i_trp(:,:,:) 
    363  
    364 !+++++ 
    365      WRITE(numout,*) ' After advection   ' 
    366      WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    367         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    368 !+++++ 
    369  
    370      ENDIF ! num_sal .EQ. 2 
    371                
    372      CALL lim_var_glo2eqv 
    373  
    374 !-------------------------------------- 
    375 ! 2. Review of all pathological cases 
    376 !-------------------------------------- 
    377  
    378      zrtt          = 173.15 * rone 
    379      zacrith       = 1.0e-6 
    380  
    381      !------------------------------------------- 
    382      ! 2.1) Advection of ice in an ice-free cell 
    383      !------------------------------------------- 
    384      ! should be removed since it is treated after dynamics now 
    385  
    386      zhimax = 5.0 
    387      ! first category 
    388      DO jj = 1, jpj 
    389         DO ji = 1, jpi 
    390            !--- the thickness of such an ice is often out of bounds 
    391            !--- thus we recompute a new area while conserving ice volume 
    392            zat_i_old = SUM(old_a_i(ji,jj,:)) 
    393            zindb          =  MAX( rzero, SIGN( rone, ABS(d_a_i_trp(ji,jj,1)) - epsi10 ) )  
    394            IF (      ( ABS(d_v_i_trp(ji,jj,1))/MAX(ABS(d_a_i_trp(ji,jj,1)),epsi10)*zindb.GT.zhimax) & 
    395                 .AND.( ( v_i(ji,jj,1)/MAX(a_i(ji,jj,1),epsi10)*zindb).GT.zhimax ) & 
    396                 .AND.( zat_i_old.LT.zacrith ) )  THEN ! new line 
    397               z_prescr_hi      = hi_max(1) / 2.0 
    398               a_i(ji,jj,1)     = v_i(ji,jj,1) / z_prescr_hi 
    399            ENDIF 
    400         END DO 
    401      END DO 
    402  
    403 !+++++ [ 
    404         WRITE(numout,*) ' 2.1 ' 
    405         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    406         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
    407         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    408         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    409         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    410         DO jk = 1, nlay_i 
    411         WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    412         END DO 
    413 !+++++ ] 
    414  
    415 !change this 14h44 
    416      zhimax = 20.0 ! line added up 
    417      ! change this also 17 aug 
    418      zhimax = 30.0 ! line added up 
    419  
    420      DO jl = 2, jpl 
    421         jm = ice_types(jl) 
    422         DO jj = 1, jpj 
    423            DO ji = 1, jpi 
    424               zindb          =  MAX( rzero, SIGN( rone, ABS(d_a_i_trp(ji,jj,jl)) - epsi10 ) )  
    425               ! this correction is very tricky... sometimes, advection gets wrong i don't know why 
    426               ! it makes problems when the advected volume and concentration do not seem to be  
    427               ! related with each other 
    428               ! the new thickness is sometimes very big! 
    429               ! and sometimes d_a_i_trp and d_v_i_trp have different sign 
    430               ! which of course is plausible 
    431               ! but fuck! it fucks everything up :) 
    432               IF ( (ABS(d_v_i_trp(ji,jj,jl))/MAX(ABS(d_a_i_trp(ji,jj,jl)),epsi10)*zindb.GT.zhimax) & 
    433                    .AND.(v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl),epsi10)*zindb).GT.zhimax ) THEN 
    434                  z_prescr_hi  =  ( hi_max_typ(jl-ice_cat_bounds(jm,1)  ,jm) + & 
    435                                    hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) / & 
    436                                    2.0 
    437                  a_i(ji,jj,jl) = v_i(ji,jj,jl) / z_prescr_hi 
    438                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    439               ENDIF 
    440            zat_i_old = SUM(old_a_i(ji,jj,:)) 
    441  
    442            END DO ! ji 
    443         END DO !jj 
    444      END DO !jl 
    445  
    446 !+++++ [ 
    447         WRITE(numout,*) ' 2.1 initial ' 
    448         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    449         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
    450         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    451         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    452         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    453         DO jk = 1, nlay_i 
    454         WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    455         END DO 
    456 !+++++ ] 
    457  
    458      at_i(:,:) = 0.0 
    459      DO jl = 1, jpl 
    460         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    461      END DO 
    462  
    463      !---------------------------------------------------- 
    464      ! 2.2) Rebin categories with thickness out of bounds 
    465      !---------------------------------------------------- 
    466 !+++++ [ 
    467         WRITE(numout,*) ' 2.1 before rebinning ' 
    468         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    469         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
    470         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    471         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    472         DO jk = 1, nlay_i 
    473         WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    474         END DO 
    475         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    476 !+++++ ] 
     125      IF( ln_nicep ) THEN   
     126         WRITE(numout,*) ' lim_update ' 
     127         WRITE(numout,*) ' ~~~~~~~~~~ ' 
     128 
     129         WRITE(numout,*) ' O) Initial values ' 
     130         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     131         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     132         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     133         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     134         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     135         DO jk = 1, nlay_i 
     136            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     137         END DO 
     138      ENDIF 
     139 
     140      !------------------------------------------------------------------------------ 
     141      ! 1. Update of Global variables                                               | 
     142      !------------------------------------------------------------------------------ 
     143 
     144      !--------------------- 
     145      ! Ice dynamics   
     146      !--------------------- 
     147 
     148      u_ice(:,:) = u_ice(:,:) + d_u_ice_dyn(:,:) 
     149      v_ice(:,:) = v_ice(:,:) + d_v_ice_dyn(:,:) 
     150 
     151      !----------------------------- 
     152      ! Update ice and snow volumes   
     153      !----------------------------- 
     154 
     155      DO jl = 1, jpl 
     156         DO jj = 1, jpj 
     157            DO ji = 1, jpi 
     158 
     159               v_i(ji,jj,jl)  = v_i(ji,jj,jl) + d_v_i_trp(ji,jj,jl)  & 
     160                  + d_v_i_thd(ji,jj,jl)  
     161               v_s(ji,jj,jl)  = v_s(ji,jj,jl) + d_v_s_trp(ji,jj,jl)  & 
     162                  + d_v_s_thd(ji,jj,jl) 
     163            END DO 
     164         END DO 
     165      END DO 
     166 
     167      !--------------------------------- 
     168      ! Classify the pathological cases 
     169      !--------------------------------- 
     170      ! (1) v_i (new) > 0; d_v_i_thd + v_i(old) > 0 (easy case) 
     171      ! (2) v_i (new) > 0; d_v_i_thd + v_i(old) = 0 (total thermodynamic ablation) 
     172      ! (3) v_i (new) < 0; d_v_i_thd + v_i(old) > 0 (combined total ablation) 
     173      ! (4) v_i (new) < 0; d_v_i_thd + v_i(old) = 0 (total thermodynamic ablation  
     174      ! with negative advection, very pathological ) 
     175      ! (5) v_i (old) = 0; d_v_i_trp > 0 (advection of ice in a free-cell) 
     176 
     177      DO jl = 1, jpl 
     178         DO jj = 1, jpj 
     179            DO ji = 1, jpi 
     180               patho_case(ji,jj,jl) = 1 
     181               IF ( v_i(ji,jj,jl) .GE. 0.0 ) THEN 
     182                  IF ( old_v_i(ji,jj,jl) + d_v_i_thd(ji,jj,jl) .LT. epsi10 ) THEN  
     183                     patho_case(ji,jj,jl) = 2 
     184                  ENDIF 
     185               ELSE 
     186                  patho_case(ji,jj,jl) = 3 
     187                  IF ( old_v_i(ji,jj,jl) + d_v_i_thd(ji,jj,jl) .LT. epsi10 ) THEN  
     188                     patho_case(ji,jj,jl) = 4 
     189                  ENDIF 
     190               ENDIF 
     191               IF ( ( old_v_i(ji,jj,jl) .LE. epsi10 ) .AND. & 
     192                  ( d_v_i_trp(ji,jj,jl) .GT. epsi06 ) ) THEN 
     193                  patho_case(ji,jj,jl) = 5 ! advection of ice in an ice-free 
     194                  ! cell 
     195                  IF( ln_nicep ) THEN   
     196                     WRITE(numout,*) ' ALERTE patho_case still equal to 5 ' 
     197                     WRITE(numout,*) ' ji , jj   : ', ji, jj 
     198                     WRITE(numout,*) ' old_v_i   : ', old_v_i(ji,jj,jl) 
     199                     WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl) 
     200                  ENDIF 
     201 
     202               ENDIF 
     203            END DO 
     204         END DO 
     205      END DO 
     206 
     207      !-------------------- 
     208      ! Excessive ablation  
     209      !-------------------- 
     210 
     211      DO jl = 1, jpl 
     212         DO jj = 1, jpj 
     213            DO ji = 1, jpi 
     214               IF (      ( patho_case(ji,jj,jl) .EQ. 3 ) & 
     215                  .OR. ( patho_case(ji,jj,jl) .EQ. 4 ) ) THEN 
     216                  zviold         = old_v_i(ji,jj,jl) 
     217                  zvsold         = old_v_s(ji,jj,jl) 
     218                  ! in cases 3 ( combined total ablation ) 
     219                  !      and 4 ( total ablation with negative advection ) 
     220                  ! there is excessive total ablation 
     221                  ! advection is chosen to be prioritary in order to conserve mass.  
     222                  ! dv_i_thd is computed as a residual 
     223                  ! negative energy has to be kept in memory and to be given to the ocean 
     224                  ! equivalent salt flux is given to the ocean 
     225                  ! 
     226                  ! This was the best solution found. Otherwise, mass conservation in advection 
     227                  ! scheme should have been revised, which could have been a big problem 
     228                  ! Martin Vancoppenolle (2006, updated 2007) 
     229 
     230                  ! is there any ice left ? 
     231                  zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
     232                  !=1 if hi > 1e-3 and 0 if not 
     233                  zdvres        = MAX(0.0,-v_i(ji,jj,jl)) !residual volume if too much ice was molten 
     234                  !this quantity is positive 
     235                  v_i(ji,jj,jl) = zindic*v_i(ji,jj,jl)    !ice volume cannot be negative 
     236                  !correct thermodynamic ablation 
     237                  d_v_i_thd(ji,jj,jl)  = zindic  *  d_v_i_thd(ji,jj,jl) + &  
     238                     (1.0-zindic) * (-zviold - d_v_i_trp(ji,jj,jl))  
     239                  ! THIS IS NEW 
     240                  d_a_i_thd(ji,jj,jl)  = zindic  *  d_a_i_thd(ji,jj,jl) + &  
     241                     (1.0-zindic) * (-old_a_i(ji,jj,jl))  
     242 
     243                  !residual salt flux if ice is over-molten 
     244                  fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * &  
     245                     ( rhoic * zdvres / rdt_ice ) 
     246                  !             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhoic * lfus * zdvres / rdt_ice 
     247 
     248                  ! is there any snow left ? 
     249                  zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) )  
     250                  zvsold        = v_s(ji,jj,jl) 
     251                  zdvres        = MAX(0.0,-v_s(ji,jj,jl)) !residual volume if too much ice was molten 
     252                  !this quantity is positive 
     253                  v_s(ji,jj,jl) = zindsn*v_s(ji,jj,jl)    !snow volume cannot be negative 
     254                  !correct thermodynamic ablation 
     255                  d_v_s_thd(ji,jj,jl)  = zindsn  *  d_v_s_thd(ji,jj,jl) + &  
     256                     (1.0-zindsn) * (-zvsold - d_v_s_trp(ji,jj,jl))  
     257                  !unsure correction on salt flux.... maybe future will tell it was not that right 
     258 
     259                  !residual salt flux if snow is over-molten 
     260                  fsalt_res(ji,jj)  = fsalt_res(ji,jj) + sss_m(ji,jj) * &  
     261                     ( rhosn * zdvres / rdt_ice ) 
     262                  !this flux will be positive if snow was over-molten 
     263                  !             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhosn * lfus * zdvres / rdt_ice 
     264               ENDIF 
     265            END DO !ji 
     266         END DO !jj 
     267      END DO !jl 
     268 
     269      IF( ln_nicep ) THEN   
     270         DO jj = 1, jpj 
     271            DO ji = 1, jpi 
     272               IF ( ABS(fsalt_res(ji,jj)) .GT. 1.0 ) THEN  
     273                  WRITE(numout,*) ' ALERTE 1000 : residual salt flux of -> ', & 
     274                     fsalt_res(ji,jj) 
     275                  WRITE(numout,*) ' ji, jj : ', ji, jj, ' gphit, glamt : ', & 
     276                     gphit(ji,jj), glamt(ji,jj) 
     277               ENDIF 
     278            END DO 
     279         END DO 
     280 
     281         WRITE(numout,*) ' 1. Before update of Global variables ' 
     282         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     283         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     284         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     285         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     286         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     287         DO jk = 1, nlay_i 
     288            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     289         END DO 
     290      ENDIF 
     291 
     292      !--------------------------------------------- 
     293      ! Ice concentration and ice heat content 
     294      !--------------------------------------------- 
     295 
     296      a_i (:,:,:) = a_i (:,:,:)   + d_a_i_trp(:,:,:)     & 
     297         + d_a_i_thd(:,:,:) 
     298      CALL lim_var_glo2eqv ! useless, just for debug 
     299      DO jk = 1, nlay_i 
     300         WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
     301      END DO 
     302      e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_trp(:,:,:,:)   
     303      CALL lim_var_glo2eqv ! useless, just for debug 
     304      WRITE(numout,*) ' After transport update ' 
     305      DO jk = 1, nlay_i 
     306         WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
     307      END DO 
     308      e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_thd(:,:,:,:)   
     309      CALL lim_var_glo2eqv ! useless, just for debug 
     310      WRITE(numout,*) ' After thermodyn update ' 
     311      DO jk = 1, nlay_i 
     312         WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
     313      END DO 
     314 
     315      at_i(:,:) = 0.0 
     316      DO jl = 1, jpl 
     317         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     318      END DO 
     319 
     320      IF( ln_nicep ) THEN   
     321         WRITE(numout,*) ' 1. After update of Global variables (2) ' 
     322         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     323         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     324         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     325         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     326         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     327         WRITE(numout,*) ' oa_i : ', oa_i(jiindx, jjindx, 1:jpl) 
     328         WRITE(numout,*) ' e_s : ', e_s(jiindx, jjindx, 1, 1:jpl) 
     329         DO jk = 1, nlay_i 
     330            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     331         END DO 
     332      ENDIF 
     333 
     334      !------------------------------ 
     335      ! Snow temperature and ice age 
     336      !------------------------------ 
     337 
     338      e_s(:,:,:,:) = e_s(:,:,:,:)        + & 
     339         d_e_s_trp(:,:,:,:)  + & 
     340         d_e_s_thd(:,:,:,:) 
     341 
     342      oa_i(:,:,:)  = oa_i(:,:,:)         + & 
     343         d_oa_i_trp(:,:,:)   + & 
     344         d_oa_i_thd(:,:,:) 
     345 
     346      !-------------- 
     347      ! Ice salinity     
     348      !-------------- 
     349 
     350      IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN ! general case 
     351 
     352         IF( ln_nicep ) THEN   
     353            WRITE(numout,*) ' Before everything ' 
     354            WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     355            WRITE(numout,*) ' oa_i:  ', oa_i(jiindx, jjindx, 1:jpl) 
     356            DO jk = 1, nlay_i 
     357               WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     358            END DO 
     359            WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     360         ENDIF 
     361 
     362         smv_i(:,:,:) = smv_i(:,:,:)       + & 
     363            d_smv_i_thd(:,:,:) + & 
     364            d_smv_i_trp(:,:,:) 
     365 
     366         IF( ln_nicep ) THEN   
     367            WRITE(numout,*) ' After advection   ' 
     368            WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     369            WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     370         ENDIF 
     371 
     372      ENDIF ! num_sal .EQ. 2 
     373 
     374      CALL lim_var_glo2eqv 
     375 
     376      !-------------------------------------- 
     377      ! 2. Review of all pathological cases 
     378      !-------------------------------------- 
     379 
     380      zrtt          = 173.15 * rone 
     381      zacrith       = 1.0e-6 
     382 
     383      !------------------------------------------- 
     384      ! 2.1) Advection of ice in an ice-free cell 
     385      !------------------------------------------- 
     386      ! should be removed since it is treated after dynamics now 
     387 
     388      zhimax = 5.0 
     389      ! first category 
     390      DO jj = 1, jpj 
     391         DO ji = 1, jpi 
     392            !--- the thickness of such an ice is often out of bounds 
     393            !--- thus we recompute a new area while conserving ice volume 
     394            zat_i_old = SUM(old_a_i(ji,jj,:)) 
     395            zindb          =  MAX( rzero, SIGN( rone, ABS(d_a_i_trp(ji,jj,1)) - epsi10 ) )  
     396            IF (      ( ABS(d_v_i_trp(ji,jj,1))/MAX(ABS(d_a_i_trp(ji,jj,1)),epsi10)*zindb.GT.zhimax) & 
     397               .AND.( ( v_i(ji,jj,1)/MAX(a_i(ji,jj,1),epsi10)*zindb).GT.zhimax ) & 
     398               .AND.( zat_i_old.LT.zacrith ) )  THEN ! new line 
     399               z_prescr_hi      = hi_max(1) / 2.0 
     400               a_i(ji,jj,1)     = v_i(ji,jj,1) / z_prescr_hi 
     401            ENDIF 
     402         END DO 
     403      END DO 
     404 
     405      IF( ln_nicep ) THEN   
     406         WRITE(numout,*) ' 2.1 ' 
     407         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     408         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     409         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     410         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     411         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     412         DO jk = 1, nlay_i 
     413            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     414         END DO 
     415      ENDIF 
     416 
     417      !change this 14h44 
     418      zhimax = 20.0 ! line added up 
     419      ! change this also 17 aug 
     420      zhimax = 30.0 ! line added up 
     421 
     422      DO jl = 2, jpl 
     423         jm = ice_types(jl) 
     424         DO jj = 1, jpj 
     425            DO ji = 1, jpi 
     426               zindb          =  MAX( rzero, SIGN( rone, ABS(d_a_i_trp(ji,jj,jl)) - epsi10 ) )  
     427               ! this correction is very tricky... sometimes, advection gets wrong i don't know why 
     428               ! it makes problems when the advected volume and concentration do not seem to be  
     429               ! related with each other 
     430               ! the new thickness is sometimes very big! 
     431               ! and sometimes d_a_i_trp and d_v_i_trp have different sign 
     432               ! which of course is plausible 
     433               ! but fuck! it fucks everything up :) 
     434               IF ( (ABS(d_v_i_trp(ji,jj,jl))/MAX(ABS(d_a_i_trp(ji,jj,jl)),epsi10)*zindb.GT.zhimax) & 
     435                  .AND.(v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl),epsi10)*zindb).GT.zhimax ) THEN 
     436                  z_prescr_hi  =  ( hi_max_typ(jl-ice_cat_bounds(jm,1)  ,jm) + & 
     437                     hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) / & 
     438                     2.0 
     439                  a_i(ji,jj,jl) = v_i(ji,jj,jl) / z_prescr_hi 
     440                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     441               ENDIF 
     442               zat_i_old = SUM(old_a_i(ji,jj,:)) 
     443 
     444            END DO ! ji 
     445         END DO !jj 
     446      END DO !jl 
     447 
     448      IF( ln_nicep ) THEN   
     449         WRITE(numout,*) ' 2.1 initial ' 
     450         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     451         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     452         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     453         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     454         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     455         DO jk = 1, nlay_i 
     456            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     457         END DO 
     458      ENDIF 
     459 
     460      at_i(:,:) = 0.0 
     461      DO jl = 1, jpl 
     462         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     463      END DO 
     464 
     465      !---------------------------------------------------- 
     466      ! 2.2) Rebin categories with thickness out of bounds 
     467      !---------------------------------------------------- 
     468      IF( ln_nicep ) THEN   
     469         WRITE(numout,*) ' 2.1 before rebinning ' 
     470         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     471         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     472         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     473         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     474         DO jk = 1, nlay_i 
     475            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     476         END DO 
     477         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     478      ENDIF 
    477479 
    478480      DO jm = 1, jpm 
    … …  
    483485 
    484486 
    485 !+++++ [ 
    486         WRITE(numout,*) ' 2.1 after rebinning' 
    487         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    488         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
    489         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    490         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    491         DO jk = 1, nlay_i 
    492         WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    493         WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
    494         END DO 
    495         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    496 !+++++ ] 
    497  
    498      at_i(:,:) = 0.0 
    499      DO jl = 1, jpl 
    500         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    501      END DO 
    502  
    503      !--------------------------------- 
    504      ! 2.3) Melt of an internal layer 
    505      !--------------------------------- 
    506      internal_melt(:,:,:) = .false. 
    507  
    508      DO jl = 1, jpl 
    509         DO jk = 1, nlay_i 
    510            DO jj = 1, jpj  
    511               DO ji = 1, jpi 
    512                  ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    513                  IF ( ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. & 
    514                         ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) .AND. & 
    515                         ( v_i(ji,jj,jl) .GT. 0.0 ) .AND. & 
    516                         ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 
    517 !                    WRITE(numout,*) ' Internal layer melt : ' 
    518 !                    WRITE(numout,*) ' ji, jj, jk, jl : ', ji,jj,jk,jl 
    519 !                    WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 
    520 !                    WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) 
     487      IF( ln_nicep ) THEN   
     488         WRITE(numout,*) ' 2.1 after rebinning' 
     489         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     490         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     491         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     492         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     493         DO jk = 1, nlay_i 
     494            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     495            WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
     496         END DO 
     497         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     498      ENDIF 
     499 
     500      at_i(:,:) = 0.0 
     501      DO jl = 1, jpl 
     502         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     503      END DO 
     504 
     505      !--------------------------------- 
     506      ! 2.3) Melt of an internal layer 
     507      !--------------------------------- 
     508      internal_melt(:,:,:) = .false. 
     509 
     510      DO jl = 1, jpl 
     511         DO jk = 1, nlay_i 
     512            DO jj = 1, jpj  
     513               DO ji = 1, jpi 
     514                  ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
     515                  IF ( ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. & 
     516                     ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) .AND. & 
     517                     ( v_i(ji,jj,jl) .GT. 0.0 ) .AND. & 
     518                     ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 
     519                     !                    WRITE(numout,*) ' Internal layer melt : ' 
     520                     !                    WRITE(numout,*) ' ji, jj, jk, jl : ', ji,jj,jk,jl 
     521                     !                    WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 
     522                     !                    WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) 
    521523                     internal_melt(ji,jj,jl) = .true. 
    522                  ENDIF 
    523               END DO ! ji 
    524            END DO ! jj 
    525         END DO !jk 
    526      END DO !jl 
    527  
    528      DO jl = 1, jpl 
    529         DO jj = 1, jpj  
    530            DO ji = 1, jpi 
    531               IF ( internal_melt(ji,jj,jl) ) THEN 
    532               ! initial ice thickness 
    533               !----------------------- 
    534               ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    535 !             WRITE(numout,*) ' ji,jj,jl : ', ji,jj,jl 
    536 !             WRITE(numout,*) ' old ht_i: ', ht_i(ji,jj,jl) 
    537 !             WRITE(numout,*) ' Enthalpy at the beg : ', e_i(ji,jj,1:nlay_i,jl) 
    538 !             WRITE(numout,*) ' smv_i   : ', smv_i(ji,jj,jl) 
    539  
    540               ! reduce ice thickness 
    541               !----------------------- 
    542               ind_im = 0 
    543               zesum = 0.0 
    544               DO jk = 1, nlay_i 
    545                  ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    546                  IF ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR.  &  
    547                       ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) & 
    548                     ind_im = ind_im + 1 
    549                  zesum = zesum + e_i(ji,jj,jk,jl) 
    550               END DO 
    551               IF (ind_im .LT.nlay_i ) smv_i(ji,jj,jl)= smv_i(ji,jj,jl) / ht_i(ji,jj,jl) * &  
    552                              ( ht_i(ji,jj,jl) - ind_im*ht_i(ji,jj,jl) / nlay_i ) 
    553               ht_i(ji,jj,jl) = ht_i(ji,jj,jl) - ind_im*ht_i(ji,jj,jl) / nlay_i 
    554               v_i(ji,jj,jl)  = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 
    555  
    556 !             WRITE(numout,*) ' ind_im  : ', ind_im 
    557 !             WRITE(numout,*) ' new ht_i: ', ht_i(ji,jj,jl) 
    558 !             WRITE(numout,*) ' smv_i   : ', smv_i(ji,jj,jl) 
    559 !             WRITE(numout,*) ' zesum   : ', zesum 
    560  
    561               ! redistribute heat 
    562               !----------------------- 
    563               ! old thicknesses and enthalpies 
    564               ind_im = 0 
    565               DO jk = 1, nlay_i 
    566                  ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    567                  IF ( ( e_i(ji,jj,jk,jl) .GT. 0.0 ) .AND.  &  
    568                       ( t_i(ji,jj,jk,jl) .LT. ztmelts ) ) THEN 
    569                     ind_im = ind_im + 1 
    570                     zthick0(ind_im) = ht_i(ji,jj,jl) * ind_im / nlay_i 
    571                     zqm0   (ind_im) = MAX( e_i(ji,jj,jk,jl) , 0.0 ) 
    572                  ENDIF 
    573               END DO 
    574  
    575 !             WRITE(numout,*) ' Old thickness, enthalpy ' 
    576 !             WRITE(numout,*) ' Number of layer : ind_im ', ind_im 
    577 !             WRITE(numout,*) ' zthick0 : ', zthick0(1:ind_im) 
    578 !             WRITE(numout,*) ' zqm0    : ', zqm0(1:ind_im) 
    579  
    580               ! Redistributing energy on the new grid 
    581               IF ( ind_im .GT. 0 ) THEN 
    582  
    583               DO jk = 1, nlay_i 
    584                  e_i(ji,jj,jk,jl) = 0.0 
    585                  DO layer = 1, ind_im 
    586                     zweight         = MAX (  & 
    587                  MIN( ht_i(ji,jj,jl) * layer / ind_im , ht_i(ji,jj,jl) * jk / nlay_i ) -       & 
    588                  MAX( ht_i(ji,jj,jl) * (layer-1) / ind_im , ht_i(ji,jj,jl) * (jk-1) / nlay_i ) , 0.0 ) & 
    589                                  /  ( ht_i(ji,jj,jl) / ind_im ) 
    590  
    591                     e_i(ji,jj,jk,jl) =  e_i(ji,jj,jk,jl) + zweight*zqm0(layer) 
    592                  END DO !layer 
    593               END DO ! jk 
    594  
    595               zesum = 0.0 
    596               DO jk = 1, nlay_i 
    597                  zesum = zesum + e_i(ji,jj,jk,jl) 
    598               END DO 
    599  
    600 !             WRITE(numout,*) ' Enthalpy at the end : ', e_i(ji,jj,1:nlay_i,jl) 
    601 !             WRITE(numout,*) ' Volume   at the end : ', v_i(ji,jj,jl) 
    602 !             WRITE(numout,*) ' zesum : ', zesum 
    603  
    604               ELSE ! ind_im .EQ. 0, total melt 
    605                  e_i(ji,jj,jk,jl) = 0.0 
    606               ENDIF 
    607  
    608               ENDIF ! internal_melt 
    609  
    610            END DO ! ji 
    611         END DO !jj 
    612      END DO !jl 
    613 !+++++ [ 
    614         WRITE(numout,*) ' 2.3 after melt of an internal ice layer ' 
    615         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    616         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
    617         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    618         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    619         DO jk = 1, nlay_i 
    620         WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    621         WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
    622         END DO 
    623         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    624 !+++++ ] 
    625  
    626      internal_melt(:,:,:) = .false. 
    627  
    628      ! Melt of snow 
    629      !-------------- 
    630      DO jl = 1, jpl 
    631         DO jj = 1, jpj  
    632            DO ji = 1, jpi 
    633               ! snow energy of melting 
    634               ze_s = e_s(ji,jj,1,jl) * unit_fac / area(ji,jj) /              & 
    635               MAX( v_s(ji,jj,jl), 1.0e-6 )  ! snow energy of melting 
    636  
    637               ! If snow energy of melting smaller then Lf 
    638               ! Then all snow melts and meltwater, heat go to the ocean 
    639               IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = .true. 
    640  
    641               !++++++ 
    642               IF ( (ji.eq.jiindx) .AND. (jj.eq.jjindx) ) THEN 
    643                  WRITE(numout,*) ' jl    : ', jl 
    644                  WRITE(numout,*) ' ze_s  : ', ze_s 
    645                  WRITE(numout,*) ' v_s   : ', v_s(ji,jj,jl) 
    646                  WRITE(numout,*) ' rhosn : ', rhosn 
    647                  WRITE(numout,*) ' rhosn : ', lfus  
    648                  WRITE(numout,*) ' area  : ', area(ji,jj) 
    649                  WRITE(numout,*) ' rhosn * lfus : ', rhosn * lfus  
    650                  WRITE(numout,*) ' internal_melt : ', internal_melt(ji,jj,jl) 
    651               ENDIF 
    652               !++++++ 
    653  
    654            END DO 
    655         END DO 
    656      END DO 
    657  
    658      DO jl = 1, jpl 
    659         DO jj = 1, jpj  
    660            DO ji = 1, jpi 
    661               IF ( internal_melt(ji,jj,jl) ) THEN 
     524                  ENDIF 
     525               END DO ! ji 
     526            END DO ! jj 
     527         END DO !jk 
     528      END DO !jl 
     529 
     530      DO jl = 1, jpl 
     531         DO jj = 1, jpj  
     532            DO ji = 1, jpi 
     533               IF ( internal_melt(ji,jj,jl) ) THEN 
     534                  ! initial ice thickness 
     535                  !----------------------- 
     536                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     537                  !             WRITE(numout,*) ' ji,jj,jl : ', ji,jj,jl 
     538                  !             WRITE(numout,*) ' old ht_i: ', ht_i(ji,jj,jl) 
     539                  !             WRITE(numout,*) ' Enthalpy at the beg : ', e_i(ji,jj,1:nlay_i,jl) 
     540                  !             WRITE(numout,*) ' smv_i   : ', smv_i(ji,jj,jl) 
     541 
     542                  ! reduce ice thickness 
     543                  !----------------------- 
     544                  ind_im = 0 
     545                  zesum = 0.0 
     546                  DO jk = 1, nlay_i 
     547                     ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
     548                     IF ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR.  &  
     549                        ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) & 
     550                        ind_im = ind_im + 1 
     551                     zesum = zesum + e_i(ji,jj,jk,jl) 
     552                  END DO 
     553                  IF (ind_im .LT.nlay_i ) smv_i(ji,jj,jl)= smv_i(ji,jj,jl) / ht_i(ji,jj,jl) * &  
     554                     ( ht_i(ji,jj,jl) - ind_im*ht_i(ji,jj,jl) / nlay_i ) 
     555                  ht_i(ji,jj,jl) = ht_i(ji,jj,jl) - ind_im*ht_i(ji,jj,jl) / nlay_i 
     556                  v_i(ji,jj,jl)  = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 
     557 
     558                  !             WRITE(numout,*) ' ind_im  : ', ind_im 
     559                  !             WRITE(numout,*) ' new ht_i: ', ht_i(ji,jj,jl) 
     560                  !             WRITE(numout,*) ' smv_i   : ', smv_i(ji,jj,jl) 
     561                  !             WRITE(numout,*) ' zesum   : ', zesum 
     562 
     563                  ! redistribute heat 
     564                  !----------------------- 
     565                  ! old thicknesses and enthalpies 
     566                  ind_im = 0 
     567                  DO jk = 1, nlay_i 
     568                     ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
     569                     IF ( ( e_i(ji,jj,jk,jl) .GT. 0.0 ) .AND.  &  
     570                        ( t_i(ji,jj,jk,jl) .LT. ztmelts ) ) THEN 
     571                        ind_im = ind_im + 1 
     572                        zthick0(ind_im) = ht_i(ji,jj,jl) * ind_im / nlay_i 
     573                        zqm0   (ind_im) = MAX( e_i(ji,jj,jk,jl) , 0.0 ) 
     574                     ENDIF 
     575                  END DO 
     576 
     577                  !             WRITE(numout,*) ' Old thickness, enthalpy ' 
     578                  !             WRITE(numout,*) ' Number of layer : ind_im ', ind_im 
     579                  !             WRITE(numout,*) ' zthick0 : ', zthick0(1:ind_im) 
     580                  !             WRITE(numout,*) ' zqm0    : ', zqm0(1:ind_im) 
     581 
     582                  ! Redistributing energy on the new grid 
     583                  IF ( ind_im .GT. 0 ) THEN 
     584 
     585                     DO jk = 1, nlay_i 
     586                        e_i(ji,jj,jk,jl) = 0.0 
     587                        DO layer = 1, ind_im 
     588                           zweight         = MAX (  & 
     589                              MIN( ht_i(ji,jj,jl) * layer / ind_im , ht_i(ji,jj,jl) * jk / nlay_i ) -       & 
     590                              MAX( ht_i(ji,jj,jl) * (layer-1) / ind_im , ht_i(ji,jj,jl) * (jk-1) / nlay_i ) , 0.0 ) & 
     591                              /  ( ht_i(ji,jj,jl) / ind_im ) 
     592 
     593                           e_i(ji,jj,jk,jl) =  e_i(ji,jj,jk,jl) + zweight*zqm0(layer) 
     594                        END DO !layer 
     595                     END DO ! jk 
     596 
     597                     zesum = 0.0 
     598                     DO jk = 1, nlay_i 
     599                        zesum = zesum + e_i(ji,jj,jk,jl) 
     600                     END DO 
     601 
     602                     !             WRITE(numout,*) ' Enthalpy at the end : ', e_i(ji,jj,1:nlay_i,jl) 
     603                     !             WRITE(numout,*) ' Volume   at the end : ', v_i(ji,jj,jl) 
     604                     !             WRITE(numout,*) ' zesum : ', zesum 
     605 
     606                  ELSE ! ind_im .EQ. 0, total melt 
     607                     e_i(ji,jj,jk,jl) = 0.0 
     608                  ENDIF 
     609 
     610               ENDIF ! internal_melt 
     611 
     612            END DO ! ji 
     613         END DO !jj 
     614      END DO !jl 
     615      IF( ln_nicep ) THEN   
     616         WRITE(numout,*) ' 2.3 after melt of an internal ice layer ' 
     617         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     618         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     619         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     620         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     621         DO jk = 1, nlay_i 
     622            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     623            WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
     624         END DO 
     625         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     626      ENDIF 
     627 
     628      internal_melt(:,:,:) = .false. 
     629 
     630      ! Melt of snow 
     631      !-------------- 
     632      DO jl = 1, jpl 
     633         DO jj = 1, jpj  
     634            DO ji = 1, jpi 
     635               ! snow energy of melting 
     636               ze_s = e_s(ji,jj,1,jl) * unit_fac / area(ji,jj) /              & 
     637                  MAX( v_s(ji,jj,jl), 1.0e-6 )  ! snow energy of melting 
     638 
     639               ! If snow energy of melting smaller then Lf 
     640               ! Then all snow melts and meltwater, heat go to the ocean 
     641               IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = .true. 
     642 
     643               IF( ln_nicep ) THEN   
     644                  IF ( (ji.eq.jiindx) .AND. (jj.eq.jjindx) ) THEN 
     645                     WRITE(numout,*) ' jl    : ', jl 
     646                     WRITE(numout,*) ' ze_s  : ', ze_s 
     647                     WRITE(numout,*) ' v_s   : ', v_s(ji,jj,jl) 
     648                     WRITE(numout,*) ' rhosn : ', rhosn 
     649                     WRITE(numout,*) ' rhosn : ', lfus  
     650                     WRITE(numout,*) ' area  : ', area(ji,jj) 
     651                     WRITE(numout,*) ' rhosn * lfus : ', rhosn * lfus  
     652                     WRITE(numout,*) ' internal_melt : ', internal_melt(ji,jj,jl) 
     653                  ENDIF 
     654               ENDIF 
     655 
     656            END DO 
     657         END DO 
     658      END DO 
     659 
     660      DO jl = 1, jpl 
     661         DO jj = 1, jpj  
     662            DO ji = 1, jpi 
     663               IF ( internal_melt(ji,jj,jl) ) THEN 
    662664                  v_s(ji,jj,jl)   = 0.0 
    663665                  e_s(ji,jj,1,jl) = 0.0 
    664               !   ! release heat 
     666                  !   ! release heat 
    665667                  fheat_res(ji,jj) = fheat_res(ji,jj)  & 
    666                                   + ze_s * v_s(ji,jj,jl) / rdt_ice 
     668                     + ze_s * v_s(ji,jj,jl) / rdt_ice 
    667669                  ! release mass 
    668670                  rdmsnif(ji,jj) =  rdmsnif(ji,jj) + rhosn * v_s(ji,jj,jl) 
    669               ENDIF 
    670            END DO 
    671         END DO 
    672      END DO 
    673  
    674      zbigvalue      = 1.0d+20 
    675  
    676      DO jl = 1, jpl 
    677         DO jj = 1, jpj  
    678            DO ji = 1, jpi 
    679  
    680            !switches 
    681               zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi06 ) )  
    682                             !switch = 1 if a_i > 1e-06 and 0 if not 
    683               zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi06 ) ) !=1 if hs > 1e-6 and 0 if not 
    684               zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi04 ) ) !=1 if hi > 1e-3 and 0 if not 
    685               ! bug fix 25 avril 2007 
    686               zindb         = zindb*zindic 
    687  
    688            !--- 2.3 Correction to ice age  
    689            !------------------------------ 
    690 !                IF ((o_i(ji,jj,jl)-1.0)*86400.0.gt.(rdt_ice*float(numit))) THEN 
    691 !                   o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/86400.0 
    692 !                ENDIF 
    693                  IF ((oa_i(ji,jj,jl)-1.0)*86400.0.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 
    694                     oa_i(ji,jj,jl) = rdt_ice*numit/86400.0*a_i(ji,jj,jl) 
    695                  ENDIF 
    696                  oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 
    697  
    698            !--- 2.4 Correction to snow thickness 
    699            !------------------------------------- 
    700 !          ! snow thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hs = 0 
    701 !             v_s(ji,jj,jl)  = MAX( zindb * v_s(ji,jj,jl), 0.0)  
    702            ! snow thickness cannot be smaller than 1e-6 
    703               v_s(ji,jj,jl)  = zindsn*v_s(ji,jj,jl)*zindb 
    704               v_s(ji,jj,jl)  = v_s(ji,jj,jl) *  MAX( 0.0 , SIGN( 1.0 , v_s(ji,jj,jl) - epsi06 ) ) 
    705  
    706            !--- 2.5 Correction to ice thickness 
    707            !------------------------------------- 
    708            ! ice thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hi = 0 
    709               v_i(ji,jj,jl) = MAX( zindb * v_i(ji,jj,jl), 0.0) 
    710            ! ice thickness cannot be smaller than 1e-3 
    711               v_i(ji,jj,jl)  = zindic*v_i(ji,jj,jl) 
    712  
    713            !--- 2.6 Snow is transformed into ice if the original ice cover disappears 
    714            !---------------------------------------------------------------------------- 
    715              zindg          = tms(ji,jj) *  MAX( rzero , SIGN( rone , -v_i(ji,jj,jl) ) ) 
    716              v_i(ji,jj,jl)  = v_i(ji,jj,jl) + zindg * rhosn * v_s(ji,jj,jl) / rau0 
    717              v_s(ji,jj,jl)  = ( rone - zindg ) * v_s(ji,jj,jl) + &  
    718                               zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn 
    719  
    720            !--- 2.7 Correction to ice concentrations  
    721            !-------------------------------------------- 
    722            ! if greater than 0, ice concentration cannot be smaller than 1e-10 
    723               a_i(ji,jj,jl) = zindb * MAX(zindsn, zindic) * MAX( a_i(ji,jj,jl), epsi06 ) 
    724            ! then ice volume has to be corrected too... 
    725            ! instead, zap small areas 
    726  
    727            !------------------------- 
    728            ! 2.8) Snow heat content 
    729            !------------------------- 
    730  
    731               e_s(ji,jj,1,jl) = zindsn *                                & 
    732                  ( MIN ( MAX ( 0.0, e_s(ji,jj,1,jl) ), zbigvalue ) ) + & 
    733                  ( 1.0 - zindsn ) * 0.0 
    734  
    735            END DO ! ji 
    736         END DO ! jj 
    737      END DO ! jl 
    738  
    739 !+++++ [ 
    740         WRITE(numout,*) ' 2.8 ' 
    741         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    742         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
    743         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    744         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    745         DO jk = 1, nlay_i 
    746         WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    747         END DO 
    748         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    749 !+++++ ] 
    750  
    751      !------------------------ 
    752      ! 2.9) Ice heat content  
    753      !------------------------ 
    754  
    755      DO jl = 1, jpl 
    756         DO jk = 1, nlay_i 
    757            DO jj = 1, jpj  
    758               DO ji = 1, jpi 
    759                  zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi06 ) )  
    760                                ! =1 if v_i > 1e-6 and 0 if not 
    761                  e_i(ji,jj,jk,jl)= zindic * &  
    762                     ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) + & 
    763                     ( 1.0 - zindic ) * 0.0 
    764               END DO ! ji 
    765            END DO ! jj 
    766         END DO !jk 
    767      END DO !jl 
    768          
    769      WRITE(numout,*) ' 2.9 ' 
    770      DO jk = 1, nlay_i 
    771         WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    772      END DO 
    773         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    774  
    775         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    776  
    777      !--------------------- 
    778      ! 2.11) Ice salinity 
    779      !--------------------- 
    780  
    781      IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN ! general case 
    782  
    783      DO jl = 1, jpl 
    784         DO jk = 1, nlay_i 
    785            DO jj = 1, jpj  
    786               DO ji = 1, jpi 
    787                  ! salinity stays in bounds 
    788                  smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)), & 
    789                   0.1 * v_i(ji,jj,jl) ) 
    790                  i_ice_switch    =  1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) 
    791                  smv_i(ji,jj,jl)  = i_ice_switch*smv_i(ji,jj,jl) + & 
    792                                      0.1*(1.0-i_ice_switch)*v_i(ji,jj,jl) 
    793               END DO ! ji 
    794            END DO ! jj 
    795         END DO !jk 
    796      END DO !jl 
    797  
    798      ENDIF 
    799  
    800 !+++++ [ 
    801         WRITE(numout,*) ' 2.11 ' 
    802         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    803         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    804         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    805         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
    806         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    807 !+++++ ] 
    808  
    809      DO jm = 1, jpm 
    810         DO jj = 1, jpj  
    811            DO ji = 1, jpi 
    812               jl = ice_cat_bounds(jm,1) 
    813               !--- 2.12 Constrain the thickness of the smallest category above 5 cm 
    814               !---------------------------------------------------------------------- 
    815               ! the ice thickness of the smallest category should be higher than 5 cm 
    816               ! we changed hiclim to 10 
    817               zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi06 ) )  
    818               ht_i(ji,jj,jl) = zindb*v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl), epsi06) 
    819               zh            = MAX( rone , zindb * hiclim  / MAX( ht_i(ji,jj,jl) , epsi20 ) ) 
    820               ht_s(ji,jj,jl) = ht_s(ji,jj,jl)* zh 
    821 !             v_s(ji,jj,jl)  = v_s(ji,jj,jl) * zh 
    822               ht_i(ji,jj,jl) = ht_i(ji,jj,jl)* zh 
    823 !             v_i(ji,jj,jl)  = v_i(ji,jj,jl) * zh 
    824               a_i (ji,jj,jl) = a_i(ji,jj,jl) /zh 
    825            END DO !ji 
    826         END DO !jj 
    827      END DO !jm 
    828 !+++++ [ 
    829         WRITE(numout,*) ' 2.12 ' 
    830         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    831         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    832         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    833         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
    834         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    835 !+++++ ] 
    836  
    837      !--- 2.13 Total ice concentration should not exceed 1 
    838      !----------------------------------------------------- 
    839      zamax = amax 
    840      ! 2.13.1) individual concentrations cannot exceed zamax 
    841      !------------------------------------------------------ 
    842  
    843      at_i(:,:) = 0.0 
    844      DO jl = 1, jpl 
    845         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    846      END DO 
    847  
    848      ! 2.13.2) Total ice concentration cannot exceed zamax 
    849      !---------------------------------------------------- 
    850      at_i(:,:) = 0.0 
    851      DO jl = 1, jpl 
    852         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    853      END DO 
    854  
    855      DO jj = 1, jpj 
    856         DO ji = 1, jpi 
    857             
    858            ! 0) Excessive area ? 
    859            z_da_ex =  MAX( at_i(ji,jj) - zamax , 0.0 )         
    860  
    861            ! 1) Count the number of existing categories 
    862            DO jl  = 1, jpl 
    863               zindb   =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi03 ) )  
    864               zindb   =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) ) )  
    865               z_da_i(jl) = a_i(ji,jj,jl)*zindb*z_da_ex/MAX(at_i(ji,jj),epsi06) 
    866               z_dv_i(jl) = v_i(ji,jj,jl)*z_da_i(jl)/MAX(at_i(ji,jj),epsi06) 
    867               a_i(ji,jj,jl) = a_i(ji,jj,jl) - z_da_i(jl) 
    868               v_i(ji,jj,jl) = v_i(ji,jj,jl) + z_dv_i(jl) 
    869  
    870            END DO 
    871                 
    872         END DO !ji 
    873      END DO !jj 
    874  
    875 !+++++ [ 
    876         WRITE(numout,*) ' 2.13 ' 
    877         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    878         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
    879         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    880         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    881         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    882 !+++++ ] 
    883  
    884      at_i(:,:) = 0.0 
    885      DO jl = 1, jpl 
    886         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    887      END DO 
    888  
    889      DO jj = 1, jpj 
    890         DO ji = 1, jpi 
    891            IF (at_i(ji,jj).GT.1.0) THEN 
    892               WRITE(numout,*) ' lim_update ! : at_i > 1 -> PAS BIEN -> ALERTE ' 
    893               WRITE(numout,*) ' ~~~~~~~~~~   at_i     ', at_i(ji,jj) 
    894               WRITE(numout,*) ' Point ', ji, jj 
    895               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 
    896               DO jl = 1, jpl 
    897                  WRITE(numout,*) ' a_i ***         ', a_i(ji,jj,jl), ' CAT no ', jl 
    898                  WRITE(numout,*) ' a_i_old ***     ', old_a_i(ji,jj,jl), ' CAT no ', jl 
    899                  WRITE(numout,*) ' d_a_i_thd / trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 
    900               END DO 
    901 !             WRITE(numout,*) ' CORRECTION BARBARE ' 
    902 !             z_da_ex =  MAX( at_i(ji,jj) - zamax , 0.0 )         
    903            ENDIF 
    904         END DO 
    905      END DO 
    906  
    907      ! Final thickness distribution rebinning 
    908      ! -------------------------------------- 
    909 !+++++ [ 
    910         WRITE(numout,*) ' rebinning before' 
    911         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    912         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
    913         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    914         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    915         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    916 !+++++ ] 
    917 !old version 
    918 !    CALL lim_itd_th_reb(1,jpl) 
     671               ENDIF 
     672            END DO 
     673         END DO 
     674      END DO 
     675 
     676      zbigvalue      = 1.0d+20 
     677 
     678      DO jl = 1, jpl 
     679         DO jj = 1, jpj  
     680            DO ji = 1, jpi 
     681 
     682               !switches 
     683               zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi06 ) )  
     684               !switch = 1 if a_i > 1e-06 and 0 if not 
     685               zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi06 ) ) !=1 if hs > 1e-6 and 0 if not 
     686               zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi04 ) ) !=1 if hi > 1e-3 and 0 if not 
     687               ! bug fix 25 avril 2007 
     688               zindb         = zindb*zindic 
     689 
     690               !--- 2.3 Correction to ice age  
     691               !------------------------------ 
     692               !                IF ((o_i(ji,jj,jl)-1.0)*86400.0.gt.(rdt_ice*float(numit))) THEN 
     693               !                   o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/86400.0 
     694               !                ENDIF 
     695               IF ((oa_i(ji,jj,jl)-1.0)*86400.0.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 
     696                  oa_i(ji,jj,jl) = rdt_ice*numit/86400.0*a_i(ji,jj,jl) 
     697               ENDIF 
     698               oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 
     699 
     700               !--- 2.4 Correction to snow thickness 
     701               !------------------------------------- 
     702               !          ! snow thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hs = 0 
     703               !             v_s(ji,jj,jl)  = MAX( zindb * v_s(ji,jj,jl), 0.0)  
     704               ! snow thickness cannot be smaller than 1e-6 
     705               v_s(ji,jj,jl)  = zindsn*v_s(ji,jj,jl)*zindb 
     706               v_s(ji,jj,jl)  = v_s(ji,jj,jl) *  MAX( 0.0 , SIGN( 1.0 , v_s(ji,jj,jl) - epsi06 ) ) 
     707 
     708               !--- 2.5 Correction to ice thickness 
     709               !------------------------------------- 
     710               ! ice thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hi = 0 
     711               v_i(ji,jj,jl) = MAX( zindb * v_i(ji,jj,jl), 0.0) 
     712               ! ice thickness cannot be smaller than 1e-3 
     713               v_i(ji,jj,jl)  = zindic*v_i(ji,jj,jl) 
     714 
     715               !--- 2.6 Snow is transformed into ice if the original ice cover disappears 
     716               !---------------------------------------------------------------------------- 
     717               zindg          = tms(ji,jj) *  MAX( rzero , SIGN( rone , -v_i(ji,jj,jl) ) ) 
     718               v_i(ji,jj,jl)  = v_i(ji,jj,jl) + zindg * rhosn * v_s(ji,jj,jl) / rau0 
     719               v_s(ji,jj,jl)  = ( rone - zindg ) * v_s(ji,jj,jl) + &  
     720                  zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn 
     721 
     722               !--- 2.7 Correction to ice concentrations  
     723               !-------------------------------------------- 
     724               ! if greater than 0, ice concentration cannot be smaller than 1e-10 
     725               a_i(ji,jj,jl) = zindb * MAX(zindsn, zindic) * MAX( a_i(ji,jj,jl), epsi06 ) 
     726               ! then ice volume has to be corrected too... 
     727               ! instead, zap small areas 
     728 
     729               !------------------------- 
     730               ! 2.8) Snow heat content 
     731               !------------------------- 
     732 
     733               e_s(ji,jj,1,jl) = zindsn *                                & 
     734                  ( MIN ( MAX ( 0.0, e_s(ji,jj,1,jl) ), zbigvalue ) ) + & 
     735                  ( 1.0 - zindsn ) * 0.0 
     736 
     737            END DO ! ji 
     738         END DO ! jj 
     739      END DO ! jl 
     740 
     741      IF( ln_nicep ) THEN   
     742         WRITE(numout,*) ' 2.8 ' 
     743         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     744         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     745         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     746         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     747         DO jk = 1, nlay_i 
     748            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     749         END DO 
     750         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     751      ENDIF 
     752 
     753      !------------------------ 
     754      ! 2.9) Ice heat content  
     755      !------------------------ 
     756 
     757      DO jl = 1, jpl 
     758         DO jk = 1, nlay_i 
     759            DO jj = 1, jpj  
     760               DO ji = 1, jpi 
     761                  zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi06 ) )  
     762                  ! =1 if v_i > 1e-6 and 0 if not 
     763                  e_i(ji,jj,jk,jl)= zindic * &  
     764                     ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) + & 
     765                     ( 1.0 - zindic ) * 0.0 
     766               END DO ! ji 
     767            END DO ! jj 
     768         END DO !jk 
     769      END DO !jl 
     770 
     771      IF( ln_nicep ) THEN   
     772         WRITE(numout,*) ' 2.9 ' 
     773         DO jk = 1, nlay_i 
     774            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     775         END DO 
     776         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     777 
     778         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     779      ENDIF 
     780 
     781      !--------------------- 
     782      ! 2.11) Ice salinity 
     783      !--------------------- 
     784 
     785      IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN ! general case 
     786 
     787         DO jl = 1, jpl 
     788            DO jk = 1, nlay_i 
     789               DO jj = 1, jpj  
     790                  DO ji = 1, jpi 
     791                     ! salinity stays in bounds 
     792                     smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)), & 
     793                        0.1 * v_i(ji,jj,jl) ) 
     794                     i_ice_switch    =  1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) 
     795                     smv_i(ji,jj,jl)  = i_ice_switch*smv_i(ji,jj,jl) + & 
     796                        0.1*(1.0-i_ice_switch)*v_i(ji,jj,jl) 
     797                  END DO ! ji 
     798               END DO ! jj 
     799            END DO !jk 
     800         END DO !jl 
     801 
     802      ENDIF 
     803 
     804      IF( ln_nicep ) THEN   
     805         WRITE(numout,*) ' 2.11 ' 
     806         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     807         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     808         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     809         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     810         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     811      ENDIF 
     812 
     813      DO jm = 1, jpm 
     814         DO jj = 1, jpj  
     815            DO ji = 1, jpi 
     816               jl = ice_cat_bounds(jm,1) 
     817               !--- 2.12 Constrain the thickness of the smallest category above 5 cm 
     818               !---------------------------------------------------------------------- 
     819               ! the ice thickness of the smallest category should be higher than 5 cm 
     820               ! we changed hiclim to 10 
     821               zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi06 ) )  
     822               ht_i(ji,jj,jl) = zindb*v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl), epsi06) 
     823               zh            = MAX( rone , zindb * hiclim  / MAX( ht_i(ji,jj,jl) , epsi20 ) ) 
     824               ht_s(ji,jj,jl) = ht_s(ji,jj,jl)* zh 
     825               !             v_s(ji,jj,jl)  = v_s(ji,jj,jl) * zh 
     826               ht_i(ji,jj,jl) = ht_i(ji,jj,jl)* zh 
     827               !             v_i(ji,jj,jl)  = v_i(ji,jj,jl) * zh 
     828               a_i (ji,jj,jl) = a_i(ji,jj,jl) /zh 
     829            END DO !ji 
     830         END DO !jj 
     831      END DO !jm 
     832      IF( ln_nicep ) THEN   
     833         WRITE(numout,*) ' 2.12 ' 
     834         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     835         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     836         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     837         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     838         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     839      ENDIF 
     840 
     841      !--- 2.13 Total ice concentration should not exceed 1 
     842      !----------------------------------------------------- 
     843      zamax = amax 
     844      ! 2.13.1) individual concentrations cannot exceed zamax 
     845      !------------------------------------------------------ 
     846 
     847      at_i(:,:) = 0.0 
     848      DO jl = 1, jpl 
     849         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     850      END DO 
     851 
     852      ! 2.13.2) Total ice concentration cannot exceed zamax 
     853      !---------------------------------------------------- 
     854      at_i(:,:) = 0.0 
     855      DO jl = 1, jpl 
     856         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     857      END DO 
     858 
     859      DO jj = 1, jpj 
     860         DO ji = 1, jpi 
     861 
     862            ! 0) Excessive area ? 
     863            z_da_ex =  MAX( at_i(ji,jj) - zamax , 0.0 )         
     864 
     865            ! 1) Count the number of existing categories 
     866            DO jl  = 1, jpl 
     867               zindb   =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi03 ) )  
     868               zindb   =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) ) )  
     869               z_da_i(jl) = a_i(ji,jj,jl)*zindb*z_da_ex/MAX(at_i(ji,jj),epsi06) 
     870               z_dv_i(jl) = v_i(ji,jj,jl)*z_da_i(jl)/MAX(at_i(ji,jj),epsi06) 
     871               a_i(ji,jj,jl) = a_i(ji,jj,jl) - z_da_i(jl) 
     872               v_i(ji,jj,jl) = v_i(ji,jj,jl) + z_dv_i(jl) 
     873 
     874            END DO 
     875 
     876         END DO !ji 
     877      END DO !jj 
     878 
     879      IF( ln_nicep ) THEN   
     880         WRITE(numout,*) ' 2.13 ' 
     881         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     882         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     883         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     884         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     885         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     886      ENDIF 
     887 
     888      at_i(:,:) = 0.0 
     889      DO jl = 1, jpl 
     890         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     891      END DO 
     892 
     893      IF( ln_nicep ) THEN   
     894         DO jj = 1, jpj 
     895            DO ji = 1, jpi 
     896               IF (at_i(ji,jj).GT.1.0) THEN 
     897                  WRITE(numout,*) ' lim_update ! : at_i > 1 -> PAS BIEN -> ALERTE ' 
     898                  WRITE(numout,*) ' ~~~~~~~~~~   at_i     ', at_i(ji,jj) 
     899                  WRITE(numout,*) ' Point ', ji, jj 
     900                  WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 
     901                  DO jl = 1, jpl 
     902                     WRITE(numout,*) ' a_i ***         ', a_i(ji,jj,jl), ' CAT no ', jl 
     903                     WRITE(numout,*) ' a_i_old ***     ', old_a_i(ji,jj,jl), ' CAT no ', jl 
     904                     WRITE(numout,*) ' d_a_i_thd / trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 
     905                  END DO 
     906                  !             WRITE(numout,*) ' CORRECTION BARBARE ' 
     907                  !             z_da_ex =  MAX( at_i(ji,jj) - zamax , 0.0 )         
     908               ENDIF 
     909            END DO 
     910         END DO 
     911      ENDIF 
     912 
     913      ! Final thickness distribution rebinning 
     914      ! -------------------------------------- 
     915      IF( ln_nicep ) THEN   
     916         WRITE(numout,*) ' rebinning before' 
     917         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     918         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     919         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     920         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     921         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     922      ENDIF 
     923      !old version 
     924      !    CALL lim_itd_th_reb(1,jpl) 
    919925 
    920926      DO jm = 1, jpm 
    … …  
    925931         ENDIF 
    926932      END DO 
    927 !+++++ [ 
    928         WRITE(numout,*) ' rebinning final' 
    929         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
    930         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
    931         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
    932         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    933         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    934 !+++++ ] 
    935  
    936      at_i(:,:) = 0.0 
    937      DO jl = 1, jpl 
    938         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    939      END DO 
    940  
    941 !------------------------------------------------------------------------------ 
    942 ! 2) Corrections to avoid wrong values                                        | 
    943 !------------------------------------------------------------------------------ 
    944 ! Ice drift 
    945 !------------ 
     933 
     934      IF( ln_nicep ) THEN   
     935         WRITE(numout,*) ' rebinning final' 
     936         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     937         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     938         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     939         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     940         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     941      ENDIF 
     942 
     943      at_i(:,:) = 0.0 
     944      DO jl = 1, jpl 
     945         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     946      END DO 
     947 
     948      !------------------------------------------------------------------------------ 
     949      ! 2) Corrections to avoid wrong values                                        | 
     950      !------------------------------------------------------------------------------ 
     951      ! Ice drift 
     952      !------------ 
    946953 
    947954      DO jj = 2, jpjm1 
    … …  
    962969      CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    963970 
    964 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
    965 ! ALERTES 
    966 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
    967  
    968      DO jj = 1, jpj 
    969         DO ji = 1, jpi 
    970               DO jl = 1, jpl 
    971 !                IF ((v_i(ji,jj,jl).NE.0.0).AND.(a_i(ji,jj,jl).EQ.0.0)) THEN 
    972 !                   WRITE(numout,*) ' lim_update : incompatible volume and concentration ' 
    973               END DO ! jl 
    974  
    975            DO jl = 1, jpl 
    976               IF ( (a_i(ji,jj,jl).GT.1.0).OR.(at_i(ji,jj).GT.1.0) ) THEN 
    977                  zindb          =  MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi06 ) )  
    978                  WRITE(numout,*) ' lim_update : a_i > 1 ' 
    979                  WRITE(numout,*) ' PAS BIEN ----> ALERTE !!! ' 
    980                  WRITE(numout,*) ' ~~~~~~~~~~   at_i     ', at_i(ji,jj) 
    981                  WRITE(numout,*) ' Point - category', ji, jj, jl 
    982                  WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 
    983                  WRITE(numout,*) ' a_i *** a_i_old ', a_i(ji,jj,jl), old_a_i(ji,jj,jl) 
    984                  WRITE(numout,*) ' v_i *** v_i_old ', v_i(ji,jj,jl), old_v_i(ji,jj,jl) 
    985                  WRITE(numout,*) ' ht_i ***        ', v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl),epsi06)*zindb  
    986                  WRITE(numout,*) ' hi_max(jl), hi_max(jl-1) ', hi_max(jl), hi_max(jl-1) 
    987                  WRITE(numout,*) ' d_v_i_thd / trp ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl) 
    988                  WRITE(numout,*) ' d_a_i_thd / trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 
    989               ENDIF 
    990            END DO 
    991  
    992         END DO !jj 
    993      END DO !ji 
    994  
    995      WRITE(numout,*) ' TESTOSC1 ', tio_u(jiindx,jjindx), tio_v(jiindx,jjindx) 
    996      WRITE(numout,*) ' TESTOSC2 ', u_ice(jiindx,jjindx), v_ice(jiindx,jjindx) 
    997      WRITE(numout,*) ' TESTOSC3 ', u_oce(jiindx,jjindx), v_oce(jiindx,jjindx) 
    998      WRITE(numout,*) ' TESTOSC4 ', utau (jiindx,jjindx), vtau (jiindx,jjindx) 
     971      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
     972      ! ALERTES 
     973      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
     974 
     975      IF( ln_nicep ) THEN   
     976         DO jj = 1, jpj 
     977            DO ji = 1, jpi 
     978               DO jl = 1, jpl 
     979                  !                IF ((v_i(ji,jj,jl).NE.0.0).AND.(a_i(ji,jj,jl).EQ.0.0)) THEN 
     980                  !                   WRITE(numout,*) ' lim_update : incompatible volume and concentration ' 
     981               END DO ! jl 
     982 
     983               DO jl = 1, jpl 
     984                  IF ( (a_i(ji,jj,jl).GT.1.0).OR.(at_i(ji,jj).GT.1.0) ) THEN 
     985                     zindb          =  MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi06 ) )  
     986                     WRITE(numout,*) ' lim_update : a_i > 1 ' 
     987                     WRITE(numout,*) ' PAS BIEN ----> ALERTE !!! ' 
     988                     WRITE(numout,*) ' ~~~~~~~~~~   at_i     ', at_i(ji,jj) 
     989                     WRITE(numout,*) ' Point - category', ji, jj, jl 
     990                     WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 
     991                     WRITE(numout,*) ' a_i *** a_i_old ', a_i(ji,jj,jl), old_a_i(ji,jj,jl) 
     992                     WRITE(numout,*) ' v_i *** v_i_old ', v_i(ji,jj,jl), old_v_i(ji,jj,jl) 
     993                     WRITE(numout,*) ' ht_i ***        ', v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl),epsi06)*zindb  
     994                     WRITE(numout,*) ' hi_max(jl), hi_max(jl-1) ', hi_max(jl), hi_max(jl-1) 
     995                     WRITE(numout,*) ' d_v_i_thd / trp ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl) 
     996                     WRITE(numout,*) ' d_a_i_thd / trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 
     997                  ENDIF 
     998               END DO 
     999 
     1000            END DO !jj 
     1001         END DO !ji 
     1002 
     1003         WRITE(numout,*) ' TESTOSC1 ', tio_u(jiindx,jjindx), tio_v(jiindx,jjindx) 
     1004         WRITE(numout,*) ' TESTOSC2 ', u_ice(jiindx,jjindx), v_ice(jiindx,jjindx) 
     1005         WRITE(numout,*) ' TESTOSC3 ', u_oce(jiindx,jjindx), v_oce(jiindx,jjindx) 
     1006         WRITE(numout,*) ' TESTOSC4 ', utau (jiindx,jjindx), vtau (jiindx,jjindx) 
     1007      ENDIF 
    9991008 
    10001009 
    … …  
    10771086      ENDIF 
    10781087 
    1079      !--------------------- 
     1088      !--------------------- 
    10801089 
    10811090   END SUBROUTINE lim_update 

  • trunk/NEMO/LIM_SRC_3/limvar.F90

    r888 r921  
    4444   USE ice 
    4545   USE par_ice 
    46   
     46 
    4747   IMPLICIT NONE 
    4848   PRIVATE 
    … …  
    7171 
    7272   SUBROUTINE lim_var_agg(n) 
    73         !!------------------------------------------------------------------ 
    74         !!                ***  ROUTINE lim_var_agg  *** 
    75         !! ** Purpose : 
    76         !!        This routine aggregates ice-thickness-category variables to   
    77         !!                                all-ice variables 
    78         !!        i.e. it turns VGLO into VAGG 
    79         !! ** Method  : 
    80         !! 
    81         !! ** Arguments : 
    82         !!           kideb , kiut : Starting and ending points on which the  
    83         !!                         the computation is applied 
    84         !! 
    85         !! ** Inputs / Ouputs : (global commons) 
    86         !! ** Arguments : n = 1, at_i vt_i only 
    87         !!                n = 2 everything 
    88         !! 
    89         !! ** External :  
    90         !! 
    91         !! ** References : 
    92         !! 
    93         !! ** History : 
    94         !!           (01-2006) Martin Vancoppenolle, UCL-ASTR 
    95         !! 
    96         !! note : you could add an argument when you need only at_i, vt_i 
    97         !!        and when you need everything 
    98         !!------------------------------------------------------------------ 
    99         !! * Arguments 
    100  
    101         !! * Local variables 
    102         INTEGER ::   ji,       &   ! spatial dummy loop index 
    103                      jj,       &   ! spatial dummy loop index 
    104                      jk,       &   ! vertical layering dummy loop index 
    105                      jl            ! ice category dummy loop index 
    106   
    107         REAL ::      zeps, epsi16, zinda, epsi06 
    108   
    109         INTEGER, INTENT( in ) ::   n     ! describes what is needed 
    110          
    111 !!-- End of declarations 
    112 !!---------------------------------------------------------------------------------------------- 
    113        zeps = 1.0e-13 
    114        epsi16 = 1.0e-16 
    115        epsi06 = 1.0e-6 
    116  
    117        !------------------ 
    118        ! Zero everything 
    119        !------------------ 
    120  
    121        vt_i(:,:)  = 0.0 
    122        vt_s(:,:)  = 0.0 
    123        at_i(:,:)  = 0.0  
    124        ato_i(:,:) = 1.0  
    125  
    126        IF ( n .GT. 1 ) THEN 
    127           et_s(:,:)  = 0.0 
    128           ot_i(:,:)  = 0.0 
    129           smt_i(:,:) = 0.0 
    130           et_i(:,:)  = 0.0 
    131        ENDIF 
    132        
    133        !-------------------- 
    134        ! Compute variables 
    135        !-------------------- 
    136  
    137        DO jl = 1, jpl 
    138           DO jj = 1, jpj 
    139              DO ji = 1, jpi 
    140  
    141                 vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
    142                 vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
    143                 at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    144  
    145                 zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )  
    146                 icethi(ji,jj) = vt_i(ji,jj) / MAX(at_i(ji,jj),epsi16)*zinda   
    147                    ! ice thickness 
    148              END DO 
    149           END DO 
    150        END DO 
    151  
    152        DO jj = 1, jpj 
    153           DO ji = 1, jpi 
    154              ato_i(ji,jj) = MAX(1.0 - at_i(ji,jj), 0.0)   ! open water fraction 
    155           END DO 
    156        END DO  
    157  
    158        IF ( n .GT. 1 ) THEN 
    159  
    160        DO jl = 1, jpl 
    161           DO jj = 1, jpj 
    162              DO ji = 1, jpi 
    163                 et_s(ji,jj)  = et_s(ji,jj)  +     &       ! snow heat content 
    164                                e_s(ji,jj,1,jl) 
    165                 zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - 0.10 ) )  
    166                 smt_i(ji,jj) = smt_i(ji,jj) +     &       ! ice salinity 
    167                                smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , zeps ) * & 
    168                                zinda 
    169                 zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )  
    170                 ot_i(ji,jj)  = ot_i(ji,jj)  +     &       ! ice age 
    171                                oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , zeps ) * & 
    172                                zinda 
    173              END DO 
    174           END DO 
    175        END DO 
    176                  
    177        DO jl = 1, jpl 
    178           DO jk = 1, nlay_i 
    179              DO jj = 1, jpj 
    180                 DO ji = 1, jpi 
    181                    et_i(ji,jj) = et_i(ji,jj) + e_i(ji,jj,jk,jl) ! ice heat 
    182                                                                 ! content 
    183                 END DO 
    184              END DO 
    185           END DO 
    186        END DO 
    187  
    188        ENDIF ! n .GT. 1 
    189  
    190     END SUBROUTINE lim_var_agg 
    191  
    192 !============================================================================== 
    193  
    194     SUBROUTINE lim_var_glo2eqv 
    195         !!------------------------------------------------------------------ 
    196         !!                ***  ROUTINE lim_var_glo2eqv ***' 
    197         !! ** Purpose : 
    198         !!        This routine computes equivalent variables as function of     
    199         !!                              global variables  
    200         !!        i.e. it turns VGLO into VEQV 
    201         !! ** Method  : 
    202         !! 
    203         !! ** Arguments : 
    204         !!           kideb , kiut : Starting and ending points on which the  
    205         !!                         the computation is applied 
    206         !! 
    207         !! ** Inputs / Ouputs :  
    208         !! 
    209         !! ** External :  
    210         !! 
    211         !! ** References : 
    212         !! 
    213         !! ** History : 
    214         !!           (01-2006) Martin Vancoppenolle, UCL-ASTR 
    215         !! 
    216         !!------------------------------------------------------------------ 
    217  
    218         !! * Local variables 
    219         INTEGER ::   ji,       &   ! spatial dummy loop index 
    220                      jj,       &   ! spatial dummy loop index 
    221                      jk,       &   ! vertical layering dummy loop index 
    222                      jl            ! ice category dummy loop index 
    223  
    224         REAL :: zq_i, zaaa, zbbb, zccc, zdiscrim, & 
    225                 ztmelts, zindb, zq_s, zfac1, zfac2 
    226  
    227         REAL :: zeps, epsi06 
    228  
    229         zeps    = 1.0e-10 
    230         epsi06  = 1.0e-06 
    231  
    232 !!-- End of declarations 
    233 !!------------------------------------------------------------------------------ 
     73      !!------------------------------------------------------------------ 
     74      !!                ***  ROUTINE lim_var_agg  *** 
     75      !! ** Purpose : 
     76      !!        This routine aggregates ice-thickness-category variables to   
     77      !!                                all-ice variables 
     78      !!        i.e. it turns VGLO into VAGG 
     79      !! ** Method  : 
     80      !! 
     81      !! ** Arguments : 
     82      !!           kideb , kiut : Starting and ending points on which the  
     83      !!                         the computation is applied 
     84      !! 
     85      !! ** Inputs / Ouputs : (global commons) 
     86      !! ** Arguments : n = 1, at_i vt_i only 
     87      !!                n = 2 everything 
     88      !! 
     89      !! ** External :  
     90      !! 
     91      !! ** References : 
     92      !! 
     93      !! ** History : 
     94      !!           (01-2006) Martin Vancoppenolle, UCL-ASTR 
     95      !! 
     96      !! note : you could add an argument when you need only at_i, vt_i 
     97      !!        and when you need everything 
     98      !!------------------------------------------------------------------ 
     99      !! * Arguments 
     100 
     101      !! * Local variables 
     102      INTEGER ::   ji,       &   ! spatial dummy loop index 
     103         jj,       &   ! spatial dummy loop index 
     104         jk,       &   ! vertical layering dummy loop index 
     105         jl            ! ice category dummy loop index 
     106 
     107      REAL ::      zeps, epsi16, zinda, epsi06 
     108 
     109      INTEGER, INTENT( in ) ::   n     ! describes what is needed 
     110 
     111      !!-- End of declarations 
     112      !!---------------------------------------------------------------------------------------------- 
     113      zeps = 1.0e-13 
     114      epsi16 = 1.0e-16 
     115      epsi06 = 1.0e-6 
     116 
     117      !------------------ 
     118      ! Zero everything 
     119      !------------------ 
     120 
     121      vt_i(:,:)  = 0.0 
     122      vt_s(:,:)  = 0.0 
     123      at_i(:,:)  = 0.0  
     124      ato_i(:,:) = 1.0  
     125 
     126      IF ( n .GT. 1 ) THEN 
     127         et_s(:,:)  = 0.0 
     128         ot_i(:,:)  = 0.0 
     129         smt_i(:,:) = 0.0 
     130         et_i(:,:)  = 0.0 
     131      ENDIF 
     132 
     133      !-------------------- 
     134      ! Compute variables 
     135      !-------------------- 
     136 
     137      DO jl = 1, jpl 
     138         DO jj = 1, jpj 
     139            DO ji = 1, jpi 
     140 
     141               vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
     142               vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
     143               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
     144 
     145               zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )  
     146               icethi(ji,jj) = vt_i(ji,jj) / MAX(at_i(ji,jj),epsi16)*zinda   
     147               ! ice thickness 
     148            END DO 
     149         END DO 
     150      END DO 
     151 
     152      DO jj = 1, jpj 
     153         DO ji = 1, jpi 
     154            ato_i(ji,jj) = MAX(1.0 - at_i(ji,jj), 0.0)   ! open water fraction 
     155         END DO 
     156      END DO 
     157 
     158      IF ( n .GT. 1 ) THEN 
     159 
     160         DO jl = 1, jpl 
     161            DO jj = 1, jpj 
     162               DO ji = 1, jpi 
     163                  et_s(ji,jj)  = et_s(ji,jj)  +     &       ! snow heat content 
     164                     e_s(ji,jj,1,jl) 
     165                  zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - 0.10 ) )  
     166                  smt_i(ji,jj) = smt_i(ji,jj) +     &       ! ice salinity 
     167                     smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , zeps ) * & 
     168                     zinda 
     169                  zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )  
     170                  ot_i(ji,jj)  = ot_i(ji,jj)  +     &       ! ice age 
     171                     oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , zeps ) * & 
     172                     zinda 
     173               END DO 
     174            END DO 
     175         END DO 
     176 
     177         DO jl = 1, jpl 
     178            DO jk = 1, nlay_i 
     179               DO jj = 1, jpj 
     180                  DO ji = 1, jpi 
     181                     et_i(ji,jj) = et_i(ji,jj) + e_i(ji,jj,jk,jl) ! ice heat 
     182                     ! content 
     183                  END DO 
     184               END DO 
     185            END DO 
     186         END DO 
     187 
     188      ENDIF ! n .GT. 1 
     189 
     190   END SUBROUTINE lim_var_agg 
     191 
     192   !============================================================================== 
     193 
     194   SUBROUTINE lim_var_glo2eqv 
     195      !!------------------------------------------------------------------ 
     196      !!                ***  ROUTINE lim_var_glo2eqv ***' 
     197      !! ** Purpose : 
     198      !!        This routine computes equivalent variables as function of     
     199      !!                              global variables  
     200      !!        i.e. it turns VGLO into VEQV 
     201      !! ** Method  : 
     202      !! 
     203      !! ** Arguments : 
     204      !!           kideb , kiut : Starting and ending points on which the  
     205      !!                         the computation is applied 
     206      !! 
     207      !! ** Inputs / Ouputs :  
     208      !! 
     209      !! ** External :  
     210      !! 
     211      !! ** References : 
     212      !! 
     213      !! ** History : 
     214      !!           (01-2006) Martin Vancoppenolle, UCL-ASTR 
     215      !! 
     216      !!------------------------------------------------------------------ 
     217 
     218      !! * Local variables 
     219      INTEGER ::   ji,       &   ! spatial dummy loop index 
     220         jj,       &   ! spatial dummy loop index 
     221         jk,       &   ! vertical layering dummy loop index 
     222         jl            ! ice category dummy loop index 
     223 
     224      REAL :: zq_i, zaaa, zbbb, zccc, zdiscrim, & 
     225         ztmelts, zindb, zq_s, zfac1, zfac2 
     226 
     227      REAL :: zeps, epsi06 
     228 
     229      zeps    = 1.0e-10 
     230      epsi06  = 1.0e-06 
     231 
     232      !!-- End of declarations 
     233      !!------------------------------------------------------------------------------ 
    234234 
    235235      !------------------------------------------------------- 
    … …  
    253253 
    254254!CDIR NOVERRCHK 
    255       DO jl = 1, jpl 
    256 !CDIR NOVERRCHK 
    257          DO jj = 1, jpj 
    258 !CDIR NOVERRCHK 
    259             DO ji = 1, jpi 
    260                zindb          = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes 
    261                sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX(v_i(ji,jj,jl),zeps) * zindb 
    262             END DO 
    263          END DO 
    264       END DO 
     255         DO jl = 1, jpl 
     256!CDIR NOVERRCHK 
     257            DO jj = 1, jpj 
     258!CDIR NOVERRCHK 
     259               DO ji = 1, jpi 
     260                  zindb          = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes 
     261                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX(v_i(ji,jj,jl),zeps) * zindb 
     262               END DO 
     263            END DO 
     264         END DO 
    265265 
    266266      ENDIF 
    … …  
    275275      DO jl = 1, jpl 
    276276!CDIR NOVERRCHK 
    277         DO jk = 1, nlay_i 
    278 !CDIR NOVERRCHK 
    279           DO jj = 1, jpj 
    280 !CDIR NOVERRCHK 
    281             DO ji = 1, jpi 
    282               !Energy of melting q(S,T) [J.m-3] 
    283               zq_i       = e_i(ji,jj,jk,jl) / area(ji,jj) / & 
    284                            MAX( v_i(ji,jj,jl) , epsi06 ) * nlay_i  
    285               ! zindb = 0 if no ice and 1 if yes 
    286               zindb      = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) ) ) 
    287               !convert units ! very important that this line is here 
    288               zq_i       = zq_i * unit_fac * zindb 
    289               !Ice layer melt temperature 
    290               ztmelts    =  -tmut*s_i(ji,jj,jk,jl) + rtt 
    291               !Conversion q(S,T) -> T (second order equation) 
    292               zaaa       =  cpic 
    293               zbbb       =  ( rcp - cpic ) * ( ztmelts - rtt ) + & 
    294                             zq_i / rhoic - lfus 
    295               zccc       =  lfus * (ztmelts-rtt) 
    296               zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) ) 
    297               t_i(ji,jj,jk,jl) = rtt + zindb *( - zbbb - zdiscrim ) / &  
    298                                  ( 2.0 *zaaa ) 
    299               t_i(ji,jj,jk,jl) = MIN( rtt, MAX(173.15, t_i(ji,jj,jk,jl) ) ) 
    300             END DO 
    301           END DO 
    302         END DO 
     277         DO jk = 1, nlay_i 
     278!CDIR NOVERRCHK 
     279            DO jj = 1, jpj 
     280!CDIR NOVERRCHK 
     281               DO ji = 1, jpi 
     282                  !Energy of melting q(S,T) [J.m-3] 
     283                  zq_i       = e_i(ji,jj,jk,jl) / area(ji,jj) / & 
     284                     MAX( v_i(ji,jj,jl) , epsi06 ) * nlay_i  
     285                  ! zindb = 0 if no ice and 1 if yes 
     286                  zindb      = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) ) ) 
     287                  !convert units ! very important that this line is here 
     288                  zq_i       = zq_i * unit_fac * zindb 
     289                  !Ice layer melt temperature 
     290                  ztmelts    =  -tmut*s_i(ji,jj,jk,jl) + rtt 
     291                  !Conversion q(S,T) -> T (second order equation) 
     292                  zaaa       =  cpic 
     293                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rtt ) + & 
     294                     zq_i / rhoic - lfus 
     295                  zccc       =  lfus * (ztmelts-rtt) 
     296                  zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) ) 
     297                  t_i(ji,jj,jk,jl) = rtt + zindb *( - zbbb - zdiscrim ) / &  
     298                     ( 2.0 *zaaa ) 
     299                  t_i(ji,jj,jk,jl) = MIN( rtt, MAX(173.15, t_i(ji,jj,jk,jl) ) ) 
     300               END DO 
     301            END DO 
     302         END DO 
    303303      END DO 
    304304 
    … …  
    311311      DO jl = 1, jpl 
    312312!CDIR NOVERRCHK 
    313         DO jk = 1, nlay_s 
    314 !CDIR NOVERRCHK 
    315           DO jj = 1, jpj 
    316 !CDIR NOVERRCHK 
    317             DO ji = 1, jpi 
    318               !Energy of melting q(S,T) [J.m-3] 
    319               zq_s       = e_s(ji,jj,jk,jl) / area(ji,jj) / & 
    320                            MAX( v_s(ji,jj,jl) , epsi06 ) * nlay_s  
    321               ! zindb = 0 if no ice and 1 if yes 
    322               zindb      = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) ) ) 
    323               !convert units ! very important that this line is here 
    324               zq_s       = zq_s * unit_fac * zindb 
    325               t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 ) 
    326               t_s(ji,jj,jk,jl) = MIN( rtt, MAX(173.15, t_s(ji,jj,jk,jl) ) ) 
    327  
    328             END DO 
    329           END DO 
    330         END DO 
     313         DO jk = 1, nlay_s 
     314!CDIR NOVERRCHK 
     315            DO jj = 1, jpj 
     316!CDIR NOVERRCHK 
     317               DO ji = 1, jpi 
     318                  !Energy of melting q(S,T) [J.m-3] 
     319                  zq_s       = e_s(ji,jj,jk,jl) / area(ji,jj) / & 
     320                     MAX( v_s(ji,jj,jl) , epsi06 ) * nlay_s  
     321                  ! zindb = 0 if no ice and 1 if yes 
     322                  zindb      = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) ) ) 
     323                  !convert units ! very important that this line is here 
     324                  zq_s       = zq_s * unit_fac * zindb 
     325                  t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 ) 
     326                  t_s(ji,jj,jk,jl) = MIN( rtt, MAX(173.15, t_s(ji,jj,jk,jl) ) ) 
     327 
     328               END DO 
     329            END DO 
     330         END DO 
    331331      END DO 
    332332 
    … …  
    346346                  zindb          = zindb*1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) 
    347347                  tm_i(ji,jj) = tm_i(ji,jj) + t_i(ji,jj,jk,jl)*v_i(ji,jj,jl) / & 
    348                                 REAL(nlay_i) / MAX( vt_i(ji,jj) , zeps ) 
     348                     REAL(nlay_i) / MAX( vt_i(ji,jj) , zeps ) 
    349349               END DO 
    350350            END DO 
    … …  
    354354   END SUBROUTINE lim_var_glo2eqv 
    355355 
    356 !=============================================================================== 
     356   !=============================================================================== 
    357357 
    358358   SUBROUTINE lim_var_eqv2glo 
    359         !!------------------------------------------------------------------ 
    360         !!                ***  ROUTINE lim_var_eqv2glo ***' 
    361         !! ** Purpose : 
    362         !!        This routine computes global     variables as function of     
    363         !!                              equivalent variables 
    364         !!        i.e. it turns VEQV into VGLO 
    365         !! ** Method  : 
    366         !! 
    367         !! ** Arguments : 
    368         !! 
    369         !! ** Inputs / Ouputs : (global commons) 
    370         !! 
    371         !! ** External :  
    372         !! 
    373         !! ** References : 
    374         !! 
    375         !! ** History : 
    376         !!           (01-2006) Martin Vancoppenolle, UCL-ASTR 
    377         !!                     Take it easy man 
    378         !!                     Life is just a simple game, between  
    379         !!                     ups / and downs \ :@) 
    380         !! 
    381         !!------------------------------------------------------------------ 
    382  
    383        v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:) 
    384        v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
    385        smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    386        oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:) 
    387  
    388     END SUBROUTINE lim_var_eqv2glo 
    389  
    390 !=============================================================================== 
    391  
    392     SUBROUTINE lim_var_salprof 
    393         !!------------------------------------------------------------------ 
    394         !!                ***  ROUTINE lim_var_salprof ***' 
    395         !! ** Purpose : 
    396         !!        This routine computes salinity profile in function of 
    397         !!        bulk salinity      
    398         !! 
    399         !! ** Method  : If bulk salinity greater than s_i_1,  
    400         !!              the profile is assumed to be constant (S_inf) 
    401         !!              If bulk salinity lower than s_i_0, 
    402         !!              the profile is linear with 0 at the surface (S_zero) 
    403         !!              If it is between s_i_0 and s_i_1, it is a 
    404         !!              alpha-weighted linear combination of s_inf and s_zero 
    405         !! 
    406         !! ** References : Vancoppenolle et al., 2007 (in preparation) 
    407         !! 
    408         !! ** History : 
    409         !!           (08-2006) Martin Vancoppenolle, UCL-ASTR 
    410         !!                     Take it easy man 
    411         !!                     Life is just a simple game, between ups  
    412         !!                     / and downs \ :@) 
    413         !! 
    414         !!------------------------------------------------------------------ 
    415         !! * Arguments 
    416  
    417         !! * Local variables 
    418         INTEGER ::             & 
    419            ji            ,     & !: spatial dummy loop index 
    420            jj            ,     & !: spatial dummy loop index 
    421            jk            ,     & !: vertical layering dummy loop index 
    422            jl                    !: ice category dummy loop index 
    423  
    424         REAL(wp) ::            & 
    425            dummy_fac0    ,     & !: dummy factor used in computations 
    426            dummy_fac1    ,     & !: dummy factor used in computations 
    427            dummy_fac     ,     & !: dummy factor used in computations 
    428            zind0         ,     & !: switch, = 1 if sm_i lt s_i_0 
    429            zind01        ,     & !: switch, = 1 if sm_i between s_i_0 and s_i_1 
    430            zindbal       ,     & !: switch, = 1, if 2*sm_i gt sss_m 
    431            zargtemp              !: dummy factor 
    432  
    433         REAL(wp), DIMENSION(nlay_i) ::      & 
    434            zs_zero               !: linear salinity profile for salinities under 
    435                                  !: s_i_0 
    436  
    437         REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 
    438            z_slope_s     ,     & !: slope of the salinity profile 
    439            zalpha                !: weight factor for s between s_i_0 and s_i_1 
    440  
    441 !!-- End of declarations 
    442 !!------------------------------------------------------------------------------ 
     359      !!------------------------------------------------------------------ 
     360      !!                ***  ROUTINE lim_var_eqv2glo ***' 
     361      !! ** Purpose : 
     362      !!        This routine computes global     variables as function of     
     363      !!                              equivalent variables 
     364      !!        i.e. it turns VEQV into VGLO 
     365      !! ** Method  : 
     366      !! 
     367      !! ** Arguments : 
     368      !! 
     369      !! ** Inputs / Ouputs : (global commons) 
     370      !! 
     371      !! ** External :  
     372      !! 
     373      !! ** References : 
     374      !! 
     375      !! ** History : 
     376      !!           (01-2006) Martin Vancoppenolle, UCL-ASTR 
     377      !!                     Take it easy man 
     378      !!                     Life is just a simple game, between  
     379      !!                     ups / and downs \ :@) 
     380      !! 
     381      !!------------------------------------------------------------------ 
     382 
     383      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:) 
     384      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
     385      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
     386      oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:) 
     387 
     388   END SUBROUTINE lim_var_eqv2glo 
     389 
     390   !=============================================================================== 
     391 
     392   SUBROUTINE lim_var_salprof 
     393      !!------------------------------------------------------------------ 
     394      !!                ***  ROUTINE lim_var_salprof ***' 
     395      !! ** Purpose : 
     396      !!        This routine computes salinity profile in function of 
     397      !!        bulk salinity      
     398      !! 
     399      !! ** Method  : If bulk salinity greater than s_i_1,  
     400      !!              the profile is assumed to be constant (S_inf) 
     401      !!              If bulk salinity lower than s_i_0, 
     402      !!              the profile is linear with 0 at the surface (S_zero) 
     403      !!              If it is between s_i_0 and s_i_1, it is a 
     404      !!              alpha-weighted linear combination of s_inf and s_zero 
     405      !! 
     406      !! ** References : Vancoppenolle et al., 2007 (in preparation) 
     407      !! 
     408      !! ** History : 
     409      !!           (08-2006) Martin Vancoppenolle, UCL-ASTR 
     410      !!                     Take it easy man 
     411      !!                     Life is just a simple game, between ups  
     412      !!                     / and downs \ :@) 
     413      !! 
     414      !!------------------------------------------------------------------ 
     415      !! * Arguments 
     416 
     417      !! * Local variables 
     418      INTEGER ::             & 
     419         ji            ,     & !: spatial dummy loop index 
     420         jj            ,     & !: spatial dummy loop index 
     421         jk            ,     & !: vertical layering dummy loop index 
     422         jl                    !: ice category dummy loop index 
     423 
     424      REAL(wp) ::            & 
     425         dummy_fac0    ,     & !: dummy factor used in computations 
     426         dummy_fac1    ,     & !: dummy factor used in computations 
     427         dummy_fac     ,     & !: dummy factor used in computations 
     428         zind0         ,     & !: switch, = 1 if sm_i lt s_i_0 
     429         zind01        ,     & !: switch, = 1 if sm_i between s_i_0 and s_i_1 
     430         zindbal       ,     & !: switch, = 1, if 2*sm_i gt sss_m 
     431         zargtemp              !: dummy factor 
     432 
     433      REAL(wp), DIMENSION(nlay_i) ::      & 
     434         zs_zero               !: linear salinity profile for salinities under 
     435      !: s_i_0 
     436 
     437      REAL(wp), DIMENSION(jpi,jpj,jpl) :: & 
     438         z_slope_s     ,     & !: slope of the salinity profile 
     439         zalpha                !: weight factor for s between s_i_0 and s_i_1 
     440 
     441      !!-- End of declarations 
     442      !!------------------------------------------------------------------------------ 
    443443 
    444444      !--------------------------------------- 
    … …  
    468468               DO ji = 1, jpi 
    469469                  z_slope_s(ji,jj,jl) = 2.0 * sm_i(ji,jj,jl) / MAX( 0.01      & 
    470                                       , ht_i(ji,jj,jl) ) 
     470                     , ht_i(ji,jj,jl) ) 
    471471               END DO ! ji 
    472472            END DO ! jj 
    … …  
    490490                  ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    491491                  zind01 = ( 1.0 - zind0 ) *                                  & 
    492                            MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i(ji,jj,jl) ) )  
     492                     MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i(ji,jj,jl) ) )  
    493493                  ! If 2.sm_i GE sss_m then zindbal = 1 
    494494                  zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i(ji,jj,jl) -      & 
    495                   sss_m(ji,jj) ) ) 
     495                     sss_m(ji,jj) ) ) 
    496496                  zalpha(ji,jj,jl) = zind0  * 1.0                             & 
    497                                    + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + & 
    498                                                 dummy_fac1 ) 
     497                     + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + & 
     498                     dummy_fac1 ) 
    499499                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1.0 - zindbal ) 
    500500               END DO 
    … …  
    512512                     ! linear profile with 0 at the surface 
    513513                     zs_zero(jk)      = z_slope_s(ji,jj,jl) * ( jk - 1./2. ) * & 
    514                                         ht_i(ji,jj,jl) * dummy_fac 
     514                        ht_i(ji,jj,jl) * dummy_fac 
    515515                     ! weighting the profile 
    516516                     s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero(jk) +       & 
    517                                      ( 1.0 - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl) 
     517                        ( 1.0 - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl) 
    518518                  END DO ! ji 
    519519               END DO ! jj 
    … …  
    527527      !------------------------------------------------------- 
    528528      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
    529        
     529 
    530530      IF ( num_sal .EQ. 3 ) THEN 
    531531 
    … …  
    542542                     zargtemp  = ( jk - 0.5 ) / nlay_i 
    543543                     s_i(ji,jj,jk,jl) =  1.6 - 1.6 * COS( 3.14169265 * & 
    544                                          ( zargtemp**(0.407/           & 
    545                                          ( 0.573 + zargtemp ) ) ) ) 
     544                        ( zargtemp**(0.407/           & 
     545                        ( 0.573 + zargtemp ) ) ) ) 
    546546                  END DO ! ji 
    547547               END DO ! jj 
    … …  
    553553   END SUBROUTINE lim_var_salprof 
    554554 
    555 !=============================================================================== 
     555   !=============================================================================== 
    556556 
    557557   SUBROUTINE lim_var_bv 
    558         !!------------------------------------------------------------------ 
    559         !!                ***  ROUTINE lim_var_bv ***' 
    560         !! ** Purpose : 
    561         !!        This routine computes mean brine volume (%) in sea ice 
    562         !! 
    563         !! ** Method  : e = - 0.054 * S (ppt) / T (C) 
    564         !! 
    565         !! ** Arguments : 
    566         !! 
    567         !! ** Inputs / Ouputs : (global commons) 
    568         !! 
    569         !! ** External :  
    570         !! 
    571         !! ** References : Vancoppenolle et al., JGR, 2007 
    572         !! 
    573         !! ** History : 
    574         !!           (08-2006) Martin Vancoppenolle, UCL-ASTR 
    575         !! 
    576         !!------------------------------------------------------------------ 
    577         !! * Arguments 
    578  
    579         !! * Local variables 
    580         INTEGER ::   ji,       &   ! spatial dummy loop index 
    581                      jj,       &   ! spatial dummy loop index 
    582                      jk,       &   ! vertical layering dummy loop index 
    583                      jl            ! ice category dummy loop index 
    584  
    585         REAL :: zbvi,          &   ! brine volume for a single ice category 
    586                 zeps,          &   ! very small value 
    587                 zindb              ! is there ice or not 
    588  
    589 !!-- End of declarations 
    590 !!------------------------------------------------------------------------------ 
    591  
    592        zeps = 1.0e-13 
    593        bv_i(:,:) = 0.0 
    594 !CDIR NOVERRCHK 
    595        DO jl = 1, jpl 
    596 !CDIR NOVERRCHK 
    597           DO jk = 1, nlay_i 
    598 !CDIR NOVERRCHK 
    599              DO jj = 1, jpj 
    600 !CDIR NOVERRCHK 
    601                 DO ji = 1, jpi 
    602                    zindb          = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes 
    603                    zbvi = - zindb * tmut *s_i(ji,jj,jk,jl) /             &  
    604                             MIN( t_i(ji,jj,jk,jl) - 273.15 , zeps )         & 
    605                             * v_i(ji,jj,jl) / REAL(nlay_i) 
    606                    bv_i(ji,jj) = bv_i(ji,jj) + zbvi  & 
    607                             / MAX( vt_i(ji,jj) , zeps ) 
    608                 END DO 
    609              END DO 
    610           END DO 
    611        END DO 
    612  
    613    END SUBROUTINE lim_var_bv  
    614  
    615 !=============================================================================== 
     558      !!------------------------------------------------------------------ 
     559      !!                ***  ROUTINE lim_var_bv ***' 
     560      !! ** Purpose : 
     561      !!        This routine computes mean brine volume (%) in sea ice 
     562      !! 
     563      !! ** Method  : e = - 0.054 * S (ppt) / T (C) 
     564      !! 
     565      !! ** Arguments : 
     566      !! 
     567      !! ** Inputs / Ouputs : (global commons) 
     568      !! 
     569      !! ** External :  
     570      !! 
     571      !! ** References : Vancoppenolle et al., JGR, 2007 
     572      !! 
     573      !! ** History : 
     574      !!           (08-2006) Martin Vancoppenolle, UCL-ASTR 
     575      !! 
     576      !!------------------------------------------------------------------ 
     577      !! * Arguments 
     578 
     579      !! * Local variables 
     580      INTEGER ::   ji,       &   ! spatial dummy loop index 
     581         jj,       &   ! spatial dummy loop index 
     582         jk,       &   ! vertical layering dummy loop index 
     583         jl            ! ice category dummy loop index 
     584 
     585      REAL :: zbvi,          &   ! brine volume for a single ice category 
     586         zeps,          &   ! very small value 
     587         zindb              ! is there ice or not 
     588 
     589      !!-- End of declarations 
     590      !!------------------------------------------------------------------------------ 
     591 
     592      zeps = 1.0e-13 
     593      bv_i(:,:) = 0.0 
     594!CDIR NOVERRCHK 
     595      DO jl = 1, jpl 
     596!CDIR NOVERRCHK 
     597         DO jk = 1, nlay_i 
     598!CDIR NOVERRCHK 
     599            DO jj = 1, jpj 
     600!CDIR NOVERRCHK 
     601               DO ji = 1, jpi 
     602                  zindb          = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes 
     603                  zbvi = - zindb * tmut *s_i(ji,jj,jk,jl) /             &  
     604                     MIN( t_i(ji,jj,jk,jl) - 273.15 , zeps )         & 
     605                     * v_i(ji,jj,jl) / REAL(nlay_i) 
     606                  bv_i(ji,jj) = bv_i(ji,jj) + zbvi  & 
     607                     / MAX( vt_i(ji,jj) , zeps ) 
     608               END DO 
     609            END DO 
     610         END DO 
     611      END DO 
     612 
     613   END SUBROUTINE lim_var_bv 
     614 
     615   !=============================================================================== 
    616616 
    617617   SUBROUTINE lim_var_salprof1d(kideb,kiut) 
    … …  
    642642         zindbal   ,         &   ! switch if in freshwater area 
    643643         zargtemp 
    644     
     644 
    645645      REAL(wp), DIMENSION(jpij) ::            & 
    646646         z_slope_s 
    … …  
    649649         zs_zero 
    650650      !!------------------------------------------------------------------- 
    651           
     651 
    652652      !--------------------------------------- 
    653653      ! Vertically constant, constant in time 
    … …  
    670670!CDIR NOVERRCHK 
    671671         DO ji = kideb, kiut  
    672                z_slope_s(ji) = 2.0 * sm_i_b(ji) / MAX( 0.01      & 
    673                                       , ht_i_b(ji) ) 
     672            z_slope_s(ji) = 2.0 * sm_i_b(ji) / MAX( 0.01      & 
     673               , ht_i_b(ji) ) 
    674674         END DO ! ji 
    675675 
    … …  
    691691               ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    692692               zind01 = ( 1.0 - zind0 ) *                                  & 
    693                         MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i_b(ji) ) )  
     693                  MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i_b(ji) ) )  
    694694               ! if 2.sm_i GE sss_m then zindbal = 1 
    695695               zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i_b(ji) -      & 
    696                sss_m(zji,zjj) ) ) 
     696                  sss_m(zji,zjj) ) ) 
    697697 
    698698               zalpha = zind0  * 1.0                                       & 
    699                       + zind01 * ( sm_i_b(ji) * dummy_fac0 +           & 
    700                                                 dummy_fac1 ) 
     699                  + zind01 * ( sm_i_b(ji) * dummy_fac0 +           & 
     700                  dummy_fac1 ) 
    701701               zalpha = zalpha * ( 1.0 - zindbal ) 
    702702 
    703703               zs_zero(ji,jk) = z_slope_s(ji) * ( jk - 1./2. ) * & 
    704                                 ht_i_b(ji) * dummy_fac2 
     704                  ht_i_b(ji) * dummy_fac2 
    705705               ! weighting the profile 
    706706               s_i_b(ji,jk) = zalpha * zs_zero(ji,jk) +       & 
    707                            ( 1.0 - zalpha ) * sm_i_b(ji) 
     707                  ( 1.0 - zalpha ) * sm_i_b(ji) 
    708708            END DO ! ji 
    709709         END DO ! jk 
    … …  
    726726               zargtemp  = ( jk - 0.5 ) / nlay_i 
    727727               s_i_b(ji,jk)  =  1.6 - 1.6*cos(3.14169265*(zargtemp**(0.407/ & 
    728                                 (0.573+zargtemp)))) 
     728                  (0.573+zargtemp)))) 
    729729            END DO ! jk 
    730730         END DO ! ji 
    … …  
    734734   END SUBROUTINE lim_var_salprof1d 
    735735 
    736 !=============================================================================== 
     736   !=============================================================================== 
    737737 
    738738#else 
    … …  
    751751   END SUBROUTINE lim_var_salprof 
    752752   SUBROUTINE lim_var_bv           ! Emtpy routines 
    753    END SUBROUTINE lim_var_bv  
     753   END SUBROUTINE lim_var_bv 
    754754   SUBROUTINE lim_var_salprof1d    ! Emtpy routines 
    755755   END SUBROUTINE lim_var_salprof1d 

  • trunk/NEMO/LIM_SRC_3/limwri.F90

    r888 r921  
    8585      !!------------------------------------------------------------------- 
    8686      INTEGER, INTENT(in) :: & 
    87           kindic                 ! if kindic < 0 there has been an error somewhere 
     87         kindic                 ! if kindic < 0 there has been an error somewhere 
    8888 
    8989      !! * Local variables 
    9090      REAL(wp),DIMENSION(1) ::   zdept 
    91        
     91 
    9292      REAL(wp) :: & 
    9393         zsto, zsec, zjulian,zout, & 
    … …  
    9696         zcmo,               & 
    9797         zcmoa                   ! additional fields 
    98           
     98 
    9999      REAL(wp), DIMENSION(jpi,jpj) ::  & 
    100100         zfield 
    … …  
    118118         ndexitd 
    119119      !!------------------------------------------------------------------- 
    120        
     120 
    121121      ipl = jpl 
    122122 
    … …  
    124124 
    125125         CALL lim_wri_init  
    126           
     126 
    127127         WRITE(numout,*) ' lim_wri, first time step ' 
    128128         WRITE(numout,*) ' add_diag_swi ', add_diag_swi 
    … …  
    135135         ! Normal file 
    136136         !------------- 
    137           
     137 
    138138         zsto     = rdt_ice 
    139139         clop     = "ave(x)" 
    … …  
    148148         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid) 
    149149         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    150           
     150 
    151151         DO jf = 1 , noumef 
    152152            WRITE(numout,*) 'jf', jf 
    … …  
    160160 
    161161         CALL histend(nice) 
    162           
     162 
    163163         !----------------- 
    164164         ! ITD file output 
    … …  
    173173         CALL dia_nam ( clhstnama, nwrite, 'icemoa' ) 
    174174         CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit,         & 
    175                         1, jpi, 1, jpj,        & ! zoom 
    176                         0, zjulian, rdt_ice,   & ! time 
    177                         nhorida,               & ! ? linked with horizontal ... 
    178                         nicea , domain_id=nidom)                  ! file  
     175            1, jpi, 1, jpj,        & ! zoom 
     176            0, zjulian, rdt_ice,   & ! time 
     177            nhorida,               & ! ? linked with horizontal ... 
     178            nicea , domain_id=nidom)                  ! file  
    179179         CALL histvert( nicea, "icethi", "L levels",               & 
    180                         "m", ipl , hi_mean , nz ) 
     180            "m", ipl , hi_mean , nz ) 
    181181         DO jl = 1, jpl 
    182182            zmaskitd(:,:,jl) = tmask(:,:,1) 
    … …  
    185185         CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd  )   
    186186         CALL histdef( nicea, "iice_itd", "Ice area in categories"         , "-"    ,   &   
    187                        jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
     187            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    188188         CALL histdef( nicea, "iice_hid", "Ice thickness in categories"    , "m"    ,   &   
    189                        jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
     189            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    190190         CALL histdef( nicea, "iice_hsd", "Snow depth in in categories"    , "m"    ,   &   
    191                        jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
     191            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    192192         CALL histdef( nicea, "iice_std", "Ice salinity distribution"      , "ppt"  ,   &   
    193                        jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
     193            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    194194         CALL histdef( nicea, "iice_otd", "Ice age distribution"               , "days",   &   
    195                        jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
     195            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    196196         CALL histdef( nicea, "iice_etd", "Brine volume distr. "               , "%"    ,   &   
    197                        jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
     197            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    198198         CALL histend(nicea) 
    199199      ENDIF 
    200        
    201 !     !-----------------------------------------------------------------------! 
    202 !     !--2. Computation of instantaneous values                               !  
    203 !     !-----------------------------------------------------------------------! 
    204  
    205 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
     200 
     201      !     !-----------------------------------------------------------------------! 
     202      !     !--2. Computation of instantaneous values                               !  
     203      !     !-----------------------------------------------------------------------! 
     204 
     205      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
    206206      IF(lwp) THEN 
    207207         WRITE(numout,*) 
    … …  
    210210         WRITE(numout,*) ' kindic = ', kindic 
    211211      ENDIF 
    212 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
     212      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
    213213 
    214214      !-- calculs des valeurs instantanees 
    … …  
    229229 
    230230      CALL lim_var_bv 
    231        
     231 
    232232      DO jj = 2 , jpjm1 
    233233         DO ji = 2 , jpim1 
    … …  
    240240            zcmo(ji,jj,3)  = vt_s(ji,jj)/MAX(at_i(ji,jj),epsi16)*zinda 
    241241            zcmo(ji,jj,4)  = diag_bot_gr(ji,jj) * & 
    242                              86400.0 * zinda !Bottom thermodynamic ice production 
     242               86400.0 * zinda !Bottom thermodynamic ice production 
    243243            zcmo(ji,jj,5)  = diag_dyn_gr(ji,jj) * & 
    244                              86400.0 * zinda !Dynamic ice production (rid/raft) 
     244               86400.0 * zinda !Dynamic ice production (rid/raft) 
    245245            zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * & 
    246                              86400.0 * zinda !Lateral thermodynamic ice production 
     246               86400.0 * zinda !Lateral thermodynamic ice production 
    247247            zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * & 
    248                              86400.0 * zinda !Snow ice production ice production 
     248               86400.0 * zinda !Snow ice production ice production 
    249249            zcmo(ji,jj,24) = tm_i(ji,jj) - rtt 
    250250 
    251251            zcmo(ji,jj,6)  = fbif  (ji,jj) 
    252252            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj)        & 
    253      &                                + u_ice(ji-1,jj) * tmu(ji-1,jj) )    & 
    254      &                     / 2.0  
     253               &                                + u_ice(ji-1,jj) * tmu(ji-1,jj) )    & 
     254               &                     / 2.0  
    255255            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj)        & 
    256      &                                + v_ice(ji,jj-1) * tmv(ji,jj-1) )    & 
    257      &                     / 2.0 
     256               &                                + v_ice(ji,jj-1) * tmv(ji,jj-1) )    & 
     257               &                     / 2.0 
    258258            zcmo(ji,jj,9)  = sst_m(ji,jj) 
    259259            zcmo(ji,jj,10) = sss_m(ji,jj) 
    … …  
    274274            zcmo(ji,jj,28) = fsbri(ji,jj) 
    275275            zcmo(ji,jj,29) = fseqv(ji,jj) 
    276            
     276 
    277277            zcmo(ji,jj,30) = bv_i(ji,jj) 
    278278            zcmo(ji,jj,31) = hicol(ji,jj) 
    279279            zcmo(ji,jj,32) = strength(ji,jj) 
    280280            zcmo(ji,jj,33) = SQRT( zcmo(ji,jj,7)*zcmo(ji,jj,7) + & 
    281                                    zcmo(ji,jj,8)*zcmo(ji,jj,8) ) 
     281               zcmo(ji,jj,8)*zcmo(ji,jj,8) ) 
    282282            zcmo(ji,jj,34) = diag_sur_me(ji,jj) * & 
    283                              86400.0 * zinda ! Surface melt 
     283               86400.0 * zinda ! Surface melt 
    284284            zcmo(ji,jj,35) = diag_bot_me(ji,jj) * & 
    285                              86400.0 * zinda ! Bottom melt 
     285               86400.0 * zinda ! Bottom melt 
    286286            zcmo(ji,jj,36) = divu_i(ji,jj) 
    287287            zcmo(ji,jj,37) = shear_i(ji,jj) 
    … …  
    299299            END DO 
    300300         END DO 
    301           
     301 
    302302         IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN  
    303303            CALL lbc_lnk( zfield, 'T', -1. ) 
    … …  
    306306         ENDIF 
    307307 
    308 !+++++ 
     308         !+++++ 
    309309         WRITE(numout,*) 
    310310         WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim' 
    311311         WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim 
    312 !+++++ 
     312         !+++++ 
    313313         IF ( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 
    314           
     314 
    315315      END DO 
    316316 
    317317      IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
    318           WRITE(numout,*) ' Closing the icemod file ' 
    319           CALL histclo( nice ) 
     318         WRITE(numout,*) ' Closing the icemod file ' 
     319         CALL histclo( nice ) 
    320320      ENDIF 
    321321 
    … …  
    325325      IF ( add_diag_swi .EQ. 1 ) THEN 
    326326 
    327       DO jl = 1, jpl  
    328          CALL lbc_lnk( a_i(:,:,jl)  , 'T' ,  1. ) 
    329          CALL lbc_lnk( sm_i(:,:,jl) , 'T' ,  1. ) 
    330          CALL lbc_lnk( oa_i(:,:,jl) , 'T' ,  1. ) 
    331          CALL lbc_lnk( ht_i(:,:,jl) , 'T' ,  1. ) 
    332          CALL lbc_lnk( ht_s(:,:,jl) , 'T' ,  1. ) 
    333       END DO 
    334  
    335       ! Compute ice age 
    336       DO jl = 1, jpl  
    337          DO jj = 1, jpj 
    338             DO ji = 1, jpi 
    339                zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 
    340                zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * & 
    341                                zinda 
    342             END DO 
    343          END DO 
    344       END DO         
    345  
    346       ! Compute brine volume 
    347       zei(:,:,:) = 0.0 
    348       DO jl = 1, jpl  
    349          DO jk = 1, nlay_i 
     327         DO jl = 1, jpl  
     328            CALL lbc_lnk( a_i(:,:,jl)  , 'T' ,  1. ) 
     329            CALL lbc_lnk( sm_i(:,:,jl) , 'T' ,  1. ) 
     330            CALL lbc_lnk( oa_i(:,:,jl) , 'T' ,  1. ) 
     331            CALL lbc_lnk( ht_i(:,:,jl) , 'T' ,  1. ) 
     332            CALL lbc_lnk( ht_s(:,:,jl) , 'T' ,  1. ) 
     333         END DO 
     334 
     335         ! Compute ice age 
     336         DO jl = 1, jpl  
    350337            DO jj = 1, jpj 
    351338               DO ji = 1, jpi 
    352339                  zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 
    353                   zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 
    354                                 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), -1.0e-6 ) ) * & 
    355                                   zinda / nlay_i 
     340                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * & 
     341                     zinda 
    356342               END DO 
    357343            END DO 
    358344         END DO 
    359       END DO 
    360  
    361       DO jl = 1, jpl  
    362          CALL lbc_lnk( zei(:,:,jl) , 'T' ,  1. ) 
    363       END DO 
    364  
    365       CALL histwrite( nicea, "iice_itd", niter, a_i  , ndimitd , ndexitd  )   ! area 
    366       CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd  )   ! thickness 
    367       CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd  )   ! snow depth 
    368       CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd  )   ! salinity 
    369       CALL histwrite( nicea, "iice_otd", niter, zoi  , ndimitd , ndexitd  )   ! age 
    370       CALL histwrite( nicea, "iice_etd", niter, zei  , ndimitd , ndexitd  )   ! brine volume 
    371           
    372 !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 
    373 !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' ) 
    374 !     not yet implemented 
    375        
    376       IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
    377          WRITE(numout,*) ' Closing the icemod file ' 
    378          CALL histclo( nicea )  
    379       ENDIF 
     345 
     346         ! Compute brine volume 
     347         zei(:,:,:) = 0.0 
     348         DO jl = 1, jpl  
     349            DO jk = 1, nlay_i 
     350               DO jj = 1, jpj 
     351                  DO ji = 1, jpi 
     352                     zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 
     353                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 
     354                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), -1.0e-6 ) ) * & 
     355                        zinda / nlay_i 
     356                  END DO 
     357               END DO 
     358            END DO 
     359         END DO 
     360 
     361         DO jl = 1, jpl  
     362            CALL lbc_lnk( zei(:,:,jl) , 'T' ,  1. ) 
     363         END DO 
     364 
     365         CALL histwrite( nicea, "iice_itd", niter, a_i  , ndimitd , ndexitd  )   ! area 
     366         CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd  )   ! thickness 
     367         CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd  )   ! snow depth 
     368         CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd  )   ! salinity 
     369         CALL histwrite( nicea, "iice_otd", niter, zoi  , ndimitd , ndexitd  )   ! age 
     370         CALL histwrite( nicea, "iice_etd", niter, zei  , ndimitd , ndexitd  )   ! brine volume 
     371 
     372         !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 
     373         !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' ) 
     374         !     not yet implemented 
     375 
     376         IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
     377            WRITE(numout,*) ' Closing the icemod file ' 
     378            CALL histclo( nicea )  
     379         ENDIF 
    380380 
    381381      ENDIF 
    … …  
    472472      zfield(36) = field_36 
    473473      zfield(37) = field_37 
    474        
     474 
    475475      DO nf = 1, noumef 
    476476         titn  (nf) = zfield(nf)%ztitle 
    … …  
    495495         WRITE(numout,*) ' add_diag_swi ', add_diag_swi 
    496496      ENDIF 
    497              
     497 
    498498   END SUBROUTINE lim_wri_init 
    499499 

  • trunk/NEMO/LIM_SRC_3/limwri_dimg.h90

    r888 r921  
    1     SUBROUTINE lim_wri 
     1SUBROUTINE lim_wri 
    22   !!---------------------------------------------------------------------- 
    33   !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    … …  
    55   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    66   !!---------------------------------------------------------------------- 
    7     !!------------------------------------------------------------------- 
    8     !!  This routine computes the average of some variables and write it 
    9     !!  on the ouput files. 
    10     !!  ATTENTION cette routine n'est valable que si le pas de temps est 
    11     !!  egale a une fraction entiere de 1 jours. 
    12     !!  Diff 1-D 3-D : suppress common also included in etat 
    13     !!                 suppress cmoymo 11-18 
    14     !!  modif : 03/06/98 
    15     !!------------------------------------------------------------------- 
    16     !! * Local variables 
    17     USE  diawri, ONLY : dia_wri_dimg 
    18     REAL(wp),DIMENSION(1) ::   zdept 
    19  
    20     REAL(wp) :: & 
    21          zsto, zsec, zjulian,zout, & 
    22          zindh,zinda,zindb,  & 
    23          ztmu 
    24     REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 
    25          zcmo 
    26     REAL(wp), DIMENSION(jpi,jpj) ::  & 
    27          zfield 
    28     INTEGER, SAVE :: nmoyice, &  !: counter for averaging 
    29          &             nwf         !: number of fields to write on disk 
    30     INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved 
    31     ! according to namelist 
    32  
    33     REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy 
     7   !!------------------------------------------------------------------- 
     8   !!  This routine computes the average of some variables and write it 
     9   !!  on the ouput files. 
     10   !!  ATTENTION cette routine n'est valable que si le pas de temps est 
     11   !!  egale a une fraction entiere de 1 jours. 
     12   !!  Diff 1-D 3-D : suppress common also included in etat 
     13   !!                 suppress cmoymo 11-18 
     14   !!  modif : 03/06/98 
     15   !!------------------------------------------------------------------- 
     16   !! * Local variables 
     17   USE  diawri, ONLY : dia_wri_dimg 
     18   REAL(wp),DIMENSION(1) ::   zdept 
     19 
     20   REAL(wp) :: & 
     21      zsto, zsec, zjulian,zout, & 
     22      zindh,zinda,zindb,  & 
     23      ztmu 
     24   REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 
     25      zcmo 
     26   REAL(wp), DIMENSION(jpi,jpj) ::  & 
     27      zfield 
     28   INTEGER, SAVE :: nmoyice, &  !: counter for averaging 
     29      &             nwf         !: number of fields to write on disk 
     30   INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved 
     31   ! according to namelist 
     32 
     33   REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy 
    3434#if ! defined key_diainstant 
    35     LOGICAL, PARAMETER :: ll_dia_inst=.false.      ! local logical variable  
     35   LOGICAL, PARAMETER :: ll_dia_inst=.false.      ! local logical variable  
    3636#else 
    37     LOGICAL, PARAMETER :: ll_dia_inst=.true. 
     37   LOGICAL, PARAMETER :: ll_dia_inst=.true. 
    3838#endif 
    39     INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index 
    40     INTEGER :: iyear, iday, imon !  
    41  
    42     CHARACTER(LEN=80) :: clname, cltext, clmode 
    43  
    44  
    45     INTEGER , SAVE ::      & 
    46          nice, nhorid, ndim, niter, ndepid 
    47     INTEGER , DIMENSION( jpij ) , SAVE ::  & 
    48          ndex51   
    49     !!------------------------------------------------------------------- 
    50     IF ( numit == nstart ) THEN  
    51  
    52        CALL lim_wri_init  
    53  
    54        nwf = 0  
    55        ii  = 0 
    56  
    57        IF (lwp ) THEN 
    58           WRITE(numout,*) 'lim_wri : Write ice outputs in dimg' 
    59           WRITE(numout,*) '~~~~~~~~' 
    60           WRITE(numout,*) '   According to namelist_ice, following fields saved:' 
    61           DO jf =1, noumef 
    62              IF (nc(jf) == 1 ) THEN 
    63                 WRITE(numout,* ) '    -',titn(jf), nam(jf), uni(jf) 
    64              ENDIF 
    65           END DO 
    66        ENDIF 
    67  
    68        DO jf = 1, noumef 
    69           IF (nc(jf) == 1 ) nwf = nwf + 1 
    70        END DO 
    71  
    72        ALLOCATE( nsubindex (nwf) ) 
    73  
    74        DO jf = 1, noumef 
    75           IF (nc(jf) == 1 ) THEN  
    76              ii = ii +1  
    77              nsubindex(ii) = jf 
    78           END IF 
    79        END DO 
    80  
    81        zsto     = rdt_ice 
    82        zout     = nwrite * rdt_ice / nn_fsbc 
    83        zsec     = 0. 
    84        niter    = 0 
    85        zdept(1) = 0. 
    86        nmoyice  = 0 
    87  
    88     ENDIF 
     39   INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index 
     40   INTEGER :: iyear, iday, imon !  
     41 
     42   CHARACTER(LEN=80) :: clname, cltext, clmode 
     43 
     44 
     45   INTEGER , SAVE ::      & 
     46      nice, nhorid, ndim, niter, ndepid 
     47   INTEGER , DIMENSION( jpij ) , SAVE ::  & 
     48      ndex51   
     49   !!------------------------------------------------------------------- 
     50   IF ( numit == nstart ) THEN  
     51 
     52      CALL lim_wri_init  
     53 
     54      nwf = 0  
     55      ii  = 0 
     56 
     57      IF (lwp ) THEN 
     58         WRITE(numout,*) 'lim_wri : Write ice outputs in dimg' 
     59         WRITE(numout,*) '~~~~~~~~' 
     60         WRITE(numout,*) '   According to namelist_ice, following fields saved:' 
     61         DO jf =1, noumef 
     62            IF (nc(jf) == 1 ) THEN 
     63               WRITE(numout,* ) '    -',titn(jf), nam(jf), uni(jf) 
     64            ENDIF 
     65         END DO 
     66      ENDIF 
     67 
     68      DO jf = 1, noumef 
     69         IF (nc(jf) == 1 ) nwf = nwf + 1 
     70      END DO 
     71 
     72      ALLOCATE( nsubindex (nwf) ) 
     73 
     74      DO jf = 1, noumef 
     75         IF (nc(jf) == 1 ) THEN  
     76            ii = ii +1  
     77            nsubindex(ii) = jf 
     78         END IF 
     79      END DO 
     80 
     81      zsto     = rdt_ice 
     82      zout     = nwrite * rdt_ice / nn_fsbc 
     83      zsec     = 0. 
     84      niter    = 0 
     85      zdept(1) = 0. 
     86      nmoyice  = 0 
     87 
     88   ENDIF 
    8989 
    9090#if ! defined key_diainstant  
    91     !-- calculs des valeurs instantanees 
    92  
    93     zcmo(:,:, 1:jpnoumax ) = 0.e0  
    94     DO jj = 2 , jpjm1 
    95        DO ji = 2 , jpim1 
    96           zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    97           zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    98           zindb  = zindh * zinda 
    99           ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )  
    100           zcmo(ji,jj,1)  = ht_s (ji,jj,1) 
    101           zcmo(ji,jj,2)  = ht_i (ji,jj,1) 
    102           zcmo(ji,jj,3)  = hicifp(ji,jj) 
    103           zcmo(ji,jj,4)  = frld  (ji,jj) 
    104           zcmo(ji,jj,5)  = sist  (ji,jj) 
    105           zcmo(ji,jj,6)  = fbif  (ji,jj) 
    106           zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    107                + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    108                / ztmu  
    109  
    110           zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    111                + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    112                / ztmu 
    113           zcmo(ji,jj,9)  = sst_m(ji,jj) 
    114           zcmo(ji,jj,10) = sss_m(ji,jj) 
    115  
    116           zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
    117           zcmo(ji,jj,12) = qsr(ji,jj) 
    118           zcmo(ji,jj,13) = qns(ji,jj) 
    119           ! See thersf for the coefficient 
    120           zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
    121           zcmo(ji,jj,15) = utaui_ice(ji,jj) 
    122           zcmo(ji,jj,16) = vtaui_ice(ji,jj) 
    123           zcmo(ji,jj,17) = qsr (ji,jj) 
    124           zcmo(ji,jj,18) = qns(ji,jj) 
    125           zcmo(ji,jj,19) = sprecip(ji,jj) 
    126        END DO 
    127     END DO 
    128     ! Cumulates values between outputs            
    129     rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:) 
    130     nmoyice = nmoyice + 1  
    131     ! compute mean value if it is time to write on file 
    132     IF ( MOD(numit,nwrite) == 0 ) THEN 
    133        rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice) 
     91   !-- calculs des valeurs instantanees 
     92 
     93   zcmo(:,:, 1:jpnoumax ) = 0.e0  
     94   DO jj = 2 , jpjm1 
     95      DO ji = 2 , jpim1 
     96         zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
     97         zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
     98         zindb  = zindh * zinda 
     99         ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )  
     100         zcmo(ji,jj,1)  = ht_s (ji,jj,1) 
     101         zcmo(ji,jj,2)  = ht_i (ji,jj,1) 
     102         zcmo(ji,jj,3)  = hicifp(ji,jj) 
     103         zcmo(ji,jj,4)  = frld  (ji,jj) 
     104         zcmo(ji,jj,5)  = sist  (ji,jj) 
     105         zcmo(ji,jj,6)  = fbif  (ji,jj) 
     106         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     107            + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     108            / ztmu  
     109 
     110         zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     111            + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     112            / ztmu 
     113         zcmo(ji,jj,9)  = sst_m(ji,jj) 
     114         zcmo(ji,jj,10) = sss_m(ji,jj) 
     115 
     116         zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
     117         zcmo(ji,jj,12) = qsr(ji,jj) 
     118         zcmo(ji,jj,13) = qns(ji,jj) 
     119         ! See thersf for the coefficient 
     120         zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     121         zcmo(ji,jj,15) = utaui_ice(ji,jj) 
     122         zcmo(ji,jj,16) = vtaui_ice(ji,jj) 
     123         zcmo(ji,jj,17) = qsr (ji,jj) 
     124         zcmo(ji,jj,18) = qns(ji,jj) 
     125         zcmo(ji,jj,19) = sprecip(ji,jj) 
     126      END DO 
     127   END DO 
     128   ! Cumulates values between outputs            
     129   rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:) 
     130   nmoyice = nmoyice + 1  
     131   ! compute mean value if it is time to write on file 
     132   IF ( MOD(numit,nwrite) == 0 ) THEN 
     133      rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice) 
    134134#else   
    135        IF ( MOD(numit,nwrite) == 0 ) THEN  
    136           !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0 
    137           DO jj = 2 , jpjm1 
    138              DO ji = 2 , jpim1 
    139                 zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    140                 zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    141                 zindb  = zindh * zinda 
    142                 ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
    143                 rcmoy(ji,jj,1)  = ht_s (ji,jj,1) 
    144                 rcmoy(ji,jj,2)  = ht_i (ji,jj,1) 
    145                 rcmoy(ji,jj,3)  = hicifp(ji,jj) 
    146                 rcmoy(ji,jj,4)  = frld  (ji,jj) 
    147                 rcmoy(ji,jj,5)  = sist  (ji,jj) 
    148                 rcmoy(ji,jj,6)  = fbif  (ji,jj) 
    149                 rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    150                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    151                      / ztmu 
    152  
    153                 rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    154                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    155                      / ztmu 
    156                 rcmoy(ji,jj,9)  = sst_m(ji,jj) 
    157                 rcmoy(ji,jj,10) = sss_m(ji,jj) 
    158  
    159                 rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
    160                 rcmoy(ji,jj,12) = qsr(ji,jj) 
    161                 rcmoy(ji,jj,13) = qns(ji,jj) 
    162                 ! See thersf for the coefficient 
    163                 rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
    164                 rcmoy(ji,jj,15) = utaui_ice(ji,jj) 
    165                 rcmoy(ji,jj,16) = vtaui_ice(ji,jj) 
    166                 rcmoy(ji,jj,17) = qsr(ji,jj) 
    167                 rcmoy(ji,jj,18) = qns(ji,jj) 
    168                 rcmoy(ji,jj,19) = sprecip(ji,jj) 
    169              END DO 
    170           END DO 
     135      IF ( MOD(numit,nwrite) == 0 ) THEN  
     136         !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0 
     137         DO jj = 2 , jpjm1 
     138            DO ji = 2 , jpim1 
     139               zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
     140               zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
     141               zindb  = zindh * zinda 
     142               ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
     143               rcmoy(ji,jj,1)  = ht_s (ji,jj,1) 
     144               rcmoy(ji,jj,2)  = ht_i (ji,jj,1) 
     145               rcmoy(ji,jj,3)  = hicifp(ji,jj) 
     146               rcmoy(ji,jj,4)  = frld  (ji,jj) 
     147               rcmoy(ji,jj,5)  = sist  (ji,jj) 
     148               rcmoy(ji,jj,6)  = fbif  (ji,jj) 
     149               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     150                  + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     151                  / ztmu 
     152 
     153               rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     154                  + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     155                  / ztmu 
     156               rcmoy(ji,jj,9)  = sst_m(ji,jj) 
     157               rcmoy(ji,jj,10) = sss_m(ji,jj) 
     158 
     159               rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
     160               rcmoy(ji,jj,12) = qsr(ji,jj) 
     161               rcmoy(ji,jj,13) = qns(ji,jj) 
     162               ! See thersf for the coefficient 
     163               rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     164               rcmoy(ji,jj,15) = utaui_ice(ji,jj) 
     165               rcmoy(ji,jj,16) = vtaui_ice(ji,jj) 
     166               rcmoy(ji,jj,17) = qsr(ji,jj) 
     167               rcmoy(ji,jj,18) = qns(ji,jj) 
     168               rcmoy(ji,jj,19) = sprecip(ji,jj) 
     169            END DO 
     170         END DO 
    171171#endif 
    172172 
    173           ! 
    174           niter = niter + 1 
    175           DO jf = 1 , noumef 
    176              zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1) 
    177  
    178              IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN  
    179                 CALL lbc_lnk( zfield, 'T', -1. ) 
    180              ELSE  
    181                 CALL lbc_lnk( zfield, 'T',  1. ) 
    182              ENDIF 
    183              rcmoy(:,:,jf) = zfield(:,:) 
    184           END DO 
    185  
    186           IF (ll_dia_inst) THEN 
    187            clmode='instantaneous' 
    188           ELSE 
    189            WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average' 
    190           END IF 
    191           iyear = ndastp/10000 
    192           imon = (ndastp-iyear*10000)/100 
    193           iday = ndastp - imon*100 - iyear*10000 
    194           WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday 
    195           cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode) 
    196           CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex) 
    197 9000      FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc") 
    198  
    199           rcmoy(:,:,:) = 0.0 
    200           nmoyice = 0  
    201        END IF     !  MOD(numit, nwrite == 0 ) ! 
    202  
    203      END SUBROUTINE lim_wri 
     173         ! 
     174         niter = niter + 1 
     175         DO jf = 1 , noumef 
     176            zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1) 
     177 
     178            IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN  
     179               CALL lbc_lnk( zfield, 'T', -1. ) 
     180            ELSE  
     181               CALL lbc_lnk( zfield, 'T',  1. ) 
     182            ENDIF 
     183            rcmoy(:,:,jf) = zfield(:,:) 
     184         END DO 
     185 
     186         IF (ll_dia_inst) THEN 
     187            clmode='instantaneous' 
     188         ELSE 
     189            WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average' 
     190         END IF 
     191         iyear = ndastp/10000 
     192         imon = (ndastp-iyear*10000)/100 
     193         iday = ndastp - imon*100 - iyear*10000 
     194         WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday 
     195         cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode) 
     196         CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex) 
     1979000     FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc") 
     198 
     199         rcmoy(:,:,:) = 0.0 
     200         nmoyice = 0  
     201      END IF     !  MOD(numit, nwrite == 0 ) ! 
     202 
     203   END SUBROUTINE lim_wri 

  • trunk/NEMO/LIM_SRC_3/par_ice.F90

    r888 r921  
    2323      jkmax    = 6 ,           &  !: maximum number of ice layers 
    2424      nlay_s   = 1                !: number of snow layers 
    25   
     25 
    2626   !ICE MECHANICAL REDISTRIBUTION 
    2727   INTEGER , PARAMETER ::      &  !: 

  • trunk/NEMO/LIM_SRC_3/thd_ice.F90

    r888 r921  
    2222   REAL(wp) , PUBLIC ::   & !!! ** ice-thermo namelist (namicethd) ** 
    2323      hmelt   = -0.15  ,  &  !: maximum melting at the bottom; active only for 
    24                              !: one category 
     24                                !: one category 
    2525      hicmin  = 0.2    ,  &  !: (REMOVE) 
    2626      hiclim  = 0.05   ,  &  !: minimum ice thickness 
    … …  
    8484      qla_ice_1d  ,     &  !:    "                  "      qla_ice 
    8585      dqla_ice_1d ,     &  !:    "                  "      dqla_ice 
    86       ! to reintegrate longwave flux inside the ice thermodynamics 
     86                                ! to reintegrate longwave flux inside the ice thermodynamics 
    8787      qtur_ice_1d ,     &  !:    "                  "      qtur_ice 
    8888      dqtu_ice_1d ,     &  !:    "                  "      dqtu_ice 
    … …  
    130130      q_s_b                !:    Snow enthalpy per unit volume 
    131131 
    132   ! Clean the following ... 
    133   ! These variables are coded for conservation checks 
     132   ! Clean the following ... 
     133   ! These variables are coded for conservation checks 
    134134   REAL(wp), PUBLIC, DIMENSION(jpij,jpl)    ::   &  ! 
    135135      qt_i_in   ,           &  !: ice energy summed over categories (initial) 

  • trunk/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r914 r921  
    5858   LOGICAL ::   lbulk_init = .TRUE.               ! flag, bulk initialization done or not) 
    5959 
     60#if ! defined key_lim3                           
     61   ! in namicerun with LIM3 
    6062   REAL(wp) ::   cai = 1.40e-3 ! best estimate of atm drag in order to get correct FS export in ORCA2-LIM 
    6163   REAL(wp) ::   cao = 1.00e-3 ! chosen by default  ==> should depends on many things...  !!gmto be updated 
     64#endif 
    6265 
    6366   REAL(wp) ::   yearday     !: number of days per year    

  • trunk/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r918 r921  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  sbcice_lim  *** 
    4    !! Surface module :  update surface ocean boundary condition over ice 
    5    !!                   covered area using LIM sea-ice model 
     4   !! Surface module :  update the ocean surface boundary condition over ice 
     5   !!       &           covered area using LIM sea-ice model 
    66   !! Sea-Ice model  :  LIM 3.0 Sea ice model time-stepping 
    77   !!====================================================================== 
    8    !! History :  9.0   !  06-12  (M. Vancoppenolle) Original code 
    9    !!            9.0   !  06-06  (G. Madec)  Surface module from icestp.F90 
     8   !! History :  2.0   !  2006-12  (M. Vancoppenolle) Original code 
     9   !!            3.0   !  2008-02  (C. Talandier)  Surface module from icestp.F90 
     10   !!            9.0   !  2008-04  (G. Madec)  sltyle and lim_ctl routine 
    1011   !!---------------------------------------------------------------------- 
    1112#if defined key_lim3 
    … …  
    1314   !!   'key_lim3' :                                  LIM 3.0 sea-ice model 
    1415   !!---------------------------------------------------------------------- 
    15    !!---------------------------------------------------------------------- 
    16    !!   sbc_ice_lim  : sea-ice model time-stepping and 
    17    !!                  update ocean sbc over ice-covered area 
     16   !!   sbc_ice_lim  : sea-ice model time-stepping and update ocean sbc over ice-covered area 
     17   !!   lim_ctl       : alerts in case of ice model crash 
     18   !!   lim_prt_state : ice control print at a given grid point 
    1819   !!---------------------------------------------------------------------- 
    1920   USE oce             ! ocean dynamics and tracers 
    … …  
    5253   USE in_out_manager  ! I/O manager 
    5354   USE prtctl          ! Print control 
    54    USE ocfzpt          ! ocean freezing point 
    5555 
    5656   IMPLICIT NONE 
    … …  
    6161   CHARACTER(len=1) ::   cl_grid = 'C'     ! type of grid used in ice dynamics 
    6262 
     63   INTEGER          ::   nn_ico_cpl = 0    ! ice-ocean coupling indicator:         !!gm   ===>> to be put in namelist 
     64   !                                       !  = 0   LIM-3 old case 
     65   !                                       !  = 1   stresses computed using now ocean velocity 
     66   !                                       !  = 2   combination of 0 and 1 cases 
     67 
     68 
    6369   !! * Substitutions 
    6470#  include "domzgr_substitute.h90" 
    6571#  include "vectopt_loop_substitute.h90" 
    6672   !!---------------------------------------------------------------------- 
    67    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    68    !! $ Id: $ 
     73   !! NEMO/LIM 3.0 , UCL-LOCEAN-IPSL  (2008) 
     74   !! $Id: $ 
    6975   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    7076   !!---------------------------------------------------------------------- 
    … …  
    94100      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    95101      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE) 
    96       INTEGER, INTENT(in) ::   kico    ! type of ice-ocean stress 
     102      INTEGER, INTENT(in) ::   kico    ! ice-ocean stress treatment 
    97103      !! 
    98       INTEGER  ::   ji, jj, jk, jl     ! dummy loop indices 
    99       INTEGER  ::   indx               ! indexes for ice points 
    100       INTEGER  ::   numaltests         ! number of alert tests (max 20) 
    101       INTEGER  ::   alert_id           ! number of the current alert 
    102       REAL(wp) ::   ztmelts            ! ice layer melting point 
    103       REAL(wp) ::   zinda     
    104       INTEGER , DIMENSION(20) ::  numal                  ! number of alerts positive 
    105       CHARACTER (len=30), DIMENSION(20) ::   alname      ! name of alert 
     104      REAL(wp) ::   zcoef              ! temporary scalar 
    106105      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   alb_ice_os   ! albedo of the ice under overcast sky 
    107106      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   alb_ice_cs   ! albedo of ice under clear sky 
    … …  
    111110         IF(lwp) WRITE(numout,*) 
    112111         IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition'  
    113          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM) time stepping' 
    114  
     112         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping' 
     113         ! 
    115114         CALL ice_init 
    116  
    117          !+++++ 
    118          indx = 12 
    119          jiindx = 44 
    120          jjindx = 140 
    121          WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx,  & 
    122                                                   ' jjindx : ',jjindx 
    123          !+++++ 
    124  
     115         ! 
     116         IF( ln_nicep ) THEN      ! control print at a given point 
     117            jiindx = 44   ;   jjindx = 140 
     118            WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 
     119         ENDIF 
    125120      ENDIF 
    126121 
    127       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    128          ! 
    129          ! ... mean surface ocean current at ice dynamics point 
    130          !     C-grid dynamics :  U- & V-points as the ocean 
    131          u_oce(:,:) = ssu_m(:,:) * tmu(:,:) 
    132          v_oce(:,:) = ssv_m(:,:) * tmv(:,:) 
    133          ! 
    134          CALL lbc_lnk( u_oce, 'U', -1. )   ! U-point 
    135          CALL lbc_lnk( v_oce, 'V', -1. )   ! V-point 
    136  
    137          ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 
    138          t_bo(:,:) = tfreez( sss_m ) +  rt0  
    139  
    140  
    141          ! ... ice albedo 
    142          CALL albedo_ice( t_su, ht_i, ht_s, alb_ice_cs, alb_ice_os ) 
    143  
    144          ! ... Sea-ice surface boundary conditions output from bulk formulae : 
    145          !     - utaui_ice  ! surface ice stress i-component (I-point)   [N/m2] 
    146          !     - vtaui_ice  ! surface ice stress j-component (I-point)   [N/m2] 
    147          !     - qns_ice    ! non solar heat flux over ice   (T-point)   [W/m2] 
    148          !     - qsr_ice    !     solar heat flux over ice   (T-point)   [W/m2] 
    149          !     - qla_ice    ! latent    heat flux over ice   (T-point)   [W/m2] 
    150          !     - dqns_ice   ! non solar heat sensistivity    (T-point)   [W/m2] 
    151          !     - dqla_ice   ! latent    heat sensistivity    (T-point)   [W/m2] 
    152          !     - tprecip    ! total precipitation            (T-point)   [Kg/m2/s] 
    153          !     - sprecip    ! solid precipitation            (T-point)   [Kg/m2/s] 
    154          !     - fr1_i0     ! 1sr fraction of qsr penetration in ice     [%] 
    155          !     - fr2_i0     ! 2nd fraction of qsr penetration in ice     [%] 
     122      !                                        !----------------------! 
     123      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  ! 
     124         !                                     !----------------------! 
     125         !                                           !  Bulk Formulea ! 
     126         !                                           !----------------! 
     127         ! 
     128         u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point 
     129         v_oce(:,:) = ssv_m(:,:)                     ! (C-grid dynamics :  U- & V-points as the ocean) 
     130         ! 
     131         t_bo(:,:) = tfreez( sss_m ) +  rt0          ! masked sea surface freezing temperature [Kelvin] 
     132         !                                           ! (set to rt0 over land) 
     133         CALL albedo_ice( t_su, ht_i, ht_s, alb_ice_cs, alb_ice_os )  ! ... ice albedo 
     134 
     135                                                     ! Bulk formulea - provides the following fields: 
     136         ! utaui_ice, vtaui_ice : surface ice stress                     (U- & V-points)   [N/m2] 
     137         ! qsr_ice  , qns_ice   : solar & non solar heat flux over ice   (T-point)         [W/m2] 
     138         ! qla_ice              : latent heat flux over ice              (T-point)         [W/m2] 
     139         ! dqns_ice , dqla_ice  : non solar & latent heat sensistivity   (T-point)         [W/m2] 
     140         ! tprecip  , sprecip   : total & solid precipitation            (T-point)         [Kg/m2/s] 
     141         ! fr1_i0   , fr2_i0    : 1sr & 2nd fraction of qsr penetration in ice             [%] 
    156142         ! 
    157143         SELECT CASE( kblk ) 
    158          CASE( 3 )           ! CLIO bulk formulation 
    159             CALL blk_ice_clio( t_su , u_ice , v_ice   , alb_ice_cs, alb_ice_os,            & 
    160                &                             utaui_ice, vtaui_ice , qns_ice   , qsr_ice,   & 
    161                &                             qla_ice  , dqns_ice  , dqla_ice  ,            & 
    162                &                             tprecip  , sprecip   ,                        & 
    163                &                             fr1_i0   , fr2_i0    , cl_grid  ) 
    164  
    165             ! CAUTION: ocean shortwave radiation sets to zero if more than 50% of sea-ice !!gm to be removed 
    166             DO jj = 1, jpj 
    167                DO ji = 1, jpi 
    168                   zinda    = MAX(  0.e0, SIGN(  1.e0, -( -1.5 - freeze(ji,jj) )  )  ) 
    169                   qsr(ji,jj) = zinda * qsr(ji,jj) 
    170                END DO 
    171             END DO 
    172  
    173          CASE( 4 )           ! CORE bulk formulation 
    174             CALL blk_ice_core( t_su , u_ice , v_ice   , alb_ice_cs,                      & 
    175                &                             utaui_ice, vtaui_ice , qns_ice , qsr_ice,   & 
    176                &                             qla_ice  , dqns_ice  , dqla_ice,            & 
    177                &                             tprecip  , sprecip   ,                      & 
    178                &                             fr1_i0   , fr2_i0    , cl_grid  ) 
     144         CASE( 3 )                                       ! CLIO bulk formulation 
     145            CALL blk_ice_clio( t_su , u_ice    , v_ice     , alb_ice_cs, alb_ice_os,   & 
     146               &                      utaui_ice, vtaui_ice , qns_ice   , qsr_ice   ,   & 
     147               &                      qla_ice  , dqns_ice  , dqla_ice  ,               & 
     148               &                      tprecip  , sprecip   ,                           & 
     149               &                      fr1_i0   , fr2_i0    , cl_grid  ) 
     150            !          
     151         CASE( 4 )                                       ! CORE bulk formulation 
     152            CALL blk_ice_core( t_su , u_ice    , v_ice     , alb_ice_cs,               & 
     153               &                      utaui_ice, vtaui_ice , qns_ice   , qsr_ice   ,   & 
     154               &                      qla_ice  , dqns_ice  , dqla_ice  ,               & 
     155               &                      tprecip  , sprecip   ,                           & 
     156               &                      fr1_i0   , fr2_i0    , cl_grid  ) 
    179157         END SELECT 
    180158 
    181          IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    182             CALL prt_ctl_info( 'Ice Forcings ' ) 
    183             CALL prt_ctl( tab2d_1=tprecip  ,clinfo1=' sbc_ice_lim: precip   : ' ) 
    184             CALL prt_ctl( tab2d_1=utaui_ice,clinfo1=' sbc_ice_lim: utaui_ice: ', tab2d_2=vtaui_ice, clinfo2=' vtaui_ice: ' ) 
    185             CALL prt_ctl( tab2d_1=sst_m    ,clinfo1=' sbc_ice_lim: sst      : ', tab2d_2=sss_m    , clinfo2=' sss      : ' ) 
    186             CALL prt_ctl( tab2d_1=u_oce    ,clinfo1=' sbc_ice_lim: u_io     : ', tab2d_2=v_oce    , clinfo2=' v_io     : ' ) 
    187             CALL prt_ctl( tab2d_1=frld     ,clinfo1=' sbc_ice_lim: frld   1 : ' ) 
    188             ! 
    189             DO jl = 1, jpl 
    190                CALL prt_ctl_info('* - category number ', ivar1=jl) 
    191                CALL prt_ctl(tab3d_1=t_su    , clinfo1=' sbc_ice_lim: t_su      : ', kdim=jl) 
    192                CALL prt_ctl(tab3d_1=qsr_ice , clinfo1=' sbc_ice_lim: qsr_ice   : ', kdim=jl) 
    193                CALL prt_ctl(tab3d_1=qns_ice , clinfo1=' sbc_ice_lim: qns_ice   : ', kdim=jl) 
    194                CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' sbc_ice_lim: dqns_ice  : ', kdim=jl) 
    195                CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' sbc_ice_lim: qla_ice   : ', kdim=jl) 
    196                CALL prt_ctl(tab3d_1=dqla_ice, clinfo1=' sbc_ice_lim: dqla_ice  : ', kdim=jl) 
    197             END DO 
    198             ! 
    199          ENDIF 
    200  
    201          !------------------------------------------------ 
    202          ! Store old values of ice model global variables 
    203          !------------------------------------------------ 
    204  
     159         !                                           !----------------------! 
     160         !                                           ! LIM-3  time-stepping ! 
     161         !                                           !----------------------! 
     162         !  
     163         numit = numit + nn_fsbc                     ! Ice model time step 
     164         ! 
     165         !                                           ! Store previous ice values 
     166!!gm : remark   old_...   should becomes ...b  as tn versus tb   
    205167         old_a_i(:,:,:)   = a_i(:,:,:)     ! ice area 
    206168         old_e_i(:,:,:,:) = e_i(:,:,:,:)   ! ice thermal energy 
    … …  
    211173         old_oa_i(:,:,:)  = oa_i(:,:,:)    ! areal age content 
    212174 
     175         !                                           ! intialisation to zero    !!gm is it truly necessary ??? 
    213176         d_a_i_thd(:,:,:)   = 0.e0 ; d_a_i_trp(:,:,:)   = 0.e0 
    214177         d_v_i_thd(:,:,:)   = 0.e0 ; d_v_i_trp(:,:,:)   = 0.e0 
    … …  
    218181         d_smv_i_thd(:,:,:) = 0.e0 ; d_smv_i_trp(:,:,:) = 0.e0 
    219182         d_oa_i_thd(:,:,:)  = 0.e0 ; d_oa_i_trp(:,:,:)  = 0.e0 
    220  
     183         ! 
    221184         fseqv(:,:)     = 0.e0 
    222185         fsbri(:,:)     = 0.e0     ; fsalt_res(:,:) = 0.e0 
    … …  
    226189         fheat_rpo(:,:) = 0.e0     ; focea2D(:,:)   = 0.e0 
    227190         fsup2D(:,:)    = 0.e0 
    228  
     191         !  
    229192         diag_sni_gr(:,:) = 0.e0   ; diag_lat_gr(:,:) = 0.e0 
    230193         diag_bot_gr(:,:) = 0.e0   ; diag_dyn_gr(:,:) = 0.e0 
    231194         diag_bot_me(:,:) = 0.e0   ; diag_sur_me(:,:) = 0.e0 
    232  
    233195         ! dynamical invariants 
    234          delta_i(:,:) = 0.e0 
    235          divu_i(:,:)  = 0.e0 
    236          shear_i(:,:) = 0.e0 
    237  
    238          !----------------! 
    239          ! Ice model step ! 
    240          !----------------! 
    241                          numit = numit + nn_fsbc 
    242                          CALL lim_rst_opn( kt )          ! Open Ice restart file 
    243                          !+++++ 
    244                          WRITE(numout,*) ' - Beginning the time step - ' 
    245                          CALL lim_inst_state(jiindx,jjindx,1) 
    246                          WRITE(numout,*) ' ' 
    247                          !+++++ 
    248          !---------------------| 
    249          ! Dynamical processes |        
    250          !---------------------| 
    251          IF( .NOT. lk_c1d ) THEN                         ! Ice dynamics & transport (not in 1D case) 
    252                          CALL lim_dyn                         ! Ice dynamics    ( rheology/dynamics ) 
    253                          CALL lim_trp                         ! Ice transport   ( Advection/diffusion ) 
    254                          CALL lim_var_agg(1)                  ! aggregate categories, requested 
    255                          CALL lim_var_glo2eqv                 ! equivalent variables, requested for rafting 
    256                          !+++++ 
    257                          WRITE(numout,*) ' - After ice dynamics and transport ' 
    258                          CALL lim_inst_state( jiindx, jjindx, 1 ) 
    259                          WRITE(numout,*) 
    260                          WRITE(numout,*) ' Mechanical Check ************** ' 
    261                          WRITE(numout,*) ' Check what means ice divergence ' 
    262                          WRITE(numout,*) ' Total ice concentration ', at_i (jiindx,jjindx) 
    263                          WRITE(numout,*) ' Total lead fraction     ', ato_i(jiindx,jjindx) 
    264                          WRITE(numout,*) ' Sum of both             ', ato_i(jiindx,jjindx) + at_i(jiindx,jjindx) 
    265                          WRITE(numout,*) ' Sum of both minus 1     ', ato_i(jiindx,jjindx) + at_i(jiindx,jjindx) - 1.00 
    266                          !+++++ 
    267                          CALL lim_itd_me                      ! Mechanical redistribution ! (ridging/rafting) 
     196         delta_i(:,:) = 0.e0       ; divu_i (:,:) = 0.e0       ;    shear_i(:,:) = 0.e0 
     197 
     198                          CALL lim_rst_opn( kt )     ! Open Ice restart file 
     199         ! 
     200         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print 
     201         ! 
     202         IF( .NOT. lk_c1d ) THEN                     ! Ice dynamics & transport (not in 1D case) 
     203                          CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics ) 
     204                          CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion ) 
     205                          CALL lim_var_agg(1)             ! aggregate categories, requested 
     206                          CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting 
     207         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx,-1, ' - ice dyn & trp - ' )   ! control print 
     208                          CALL lim_itd_me                 ! Mechanical redistribution ! (ridging/rafting) 
    268209         ENDIF 
    269          !--------------------| 
    270          ! Ice thermodynamics | 
    271          !--------------------| 
    272                          CALL lim_var_glo2eqv            ! equivalent variables 
    273                          CALL lim_var_agg(1)             ! aggregate ice categories 
    274                          CALL lim_var_bv                 ! bulk brine volume (diag) 
    275                          CALL lim_thd                    ! Ice thermodynamics  
    276                          oa_i(:,:,:) = oa_i(:,:,:)   & 
    277                             &         + a_i(:,:,:)   & 
    278                             &         * rdt_ice      & 
    279                             &         / 86400.00         ! Ice natural aging 
    280                          CALL lim_var_glo2eqv            ! except info message that follows,  
    281                          !                               ! this CALL is maybe not necessary 
    282                          !+++++ 
    283                          WRITE(numout,*) ' - After ice thermodynamics ' 
    284                          CALL lim_inst_state(jiindx,jjindx,1) 
    285                          !+++++ 
    286                          CALL lim_itd_th                 !  Remap ice categories, lateral accretion  ! 
    287          !-------------------------| 
    288          ! Global variables update | 
    289          !-------------------------| 
    290                          CALL lim_var_agg(1)             ! requested by limupdate 
    291                          CALL lim_update                 ! Global variables update 
    292                          CALL lim_var_glo2eqv            ! equivalent variables (outputs) 
    293                          CALL lim_var_agg(2)             ! aggregate ice thickness categories 
    294                          !+++++ 
    295                          IF(ln_nicep) THEN 
    296                             WRITE(numout,*) ' - Final ice state after lim_update ' 
    297                             CALL lim_inst_state(jiindx,jjindx,2) 
    298                             WRITE(numout,*) ' ' 
    299                          ENDIF 
    300                          !+++++ 
    301          !--------------------------------------| 
    302          ! Fluxes of mass and heat to the ocean | 
    303          !--------------------------------------| 
     210         ! 
     211         !                                           ! Ice thermodynamics  
     212                          CALL lim_var_glo2eqv            ! equivalent variables 
     213                          CALL lim_var_agg(1)             ! aggregate ice categories 
     214                          CALL lim_var_bv                 ! bulk brine volume (diag) 
     215                          CALL lim_thd( kt )              ! Ice thermodynamics  
     216                          zcoef = rdt_ice / 86400.e0      !  Ice natural aging 
     217                          oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 
     218                          CALL lim_var_glo2eqv            ! this CALL is maybe not necessary (Martin) 
     219         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 1, ' - ice thermodyn. - ' )   ! control print 
     220                          CALL lim_itd_th( kt )           !  Remap ice categories, lateral accretion  ! 
     221         ! 
     222         !                                           ! Global variables update | 
     223                          CALL lim_var_agg( 1 )           ! requested by limupdate 
     224                          CALL lim_update                 ! Global variables update 
     225                          CALL lim_var_glo2eqv            ! equivalent variables (outputs) 
     226                          CALL lim_var_agg(2)             ! aggregate ice thickness categories 
     227         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 2, ' - Final state - ' )   ! control print 
     228         ! 
     229         !                                           ! Fluxes of mass and heat to the ocean | 
    304230                         CALL lim_sbc_flx( kt )           ! Ice/Ocean heat freshwater/salt fluxes 
    305231         IF( ln_limdyn .AND. kico == 0 )   &              ! Ice/Ocean stresses (only in ice-dynamic case) 
    306232            &            CALL lim_sbc_tau( kt, kico )     ! otherwise the atm.-ocean stresses are used everywhere 
    307  
    308                          !+++++ 
    309                          WRITE(numout,*) ' - Final ice state after lim_flx    ' 
    310                          CALL lim_inst_state(jiindx,jjindx,3) 
    311                          WRITE(numout,*) ' ' 
    312                          !+++++ 
    313          !-------------------------| 
    314          ! Diagnostics and outputs | 
    315          !-------------------------| 
    316          IF( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 )   & 
    317           &              CALL lim_dia                    ! Ice Diagnostics  
    318                          CALL lim_wri      ( 1  )        ! Ice outputs  
    319          IF( lrst_ice )  CALL lim_rst_write( kt )        ! Ice restart file  
    320                          CALL lim_var_glo2eqv 
    321          ! 
    322          !-------------------------------| 
    323          ! Alerts in case of model crash | 
    324          !-------------------------------| 
    325  
    326          numaltests = 10 
    327          numal(:) = 0 
    328  
    329          ! Alert if incompatible volume and concentration 
    330          alert_id = 2 ! reference number of this alert 
    331          alname(alert_id) = ' Incompat vol and con         ' ! name of the alert 
    332  
    333          DO jl = 1, jpl 
    334             DO jj = 1, jpj 
    335                DO ji = 1, jpi 
    336                      IF ((v_i(ji,jj,jl).NE.0.0).AND.(a_i(ji,jj,jl).EQ.0.0)) THEN 
    337                         WRITE(numout,*) ' ALERTE 2 ' 
    338                         WRITE(numout,*) ' Incompatible volume and concentration ' 
    339                         WRITE(numout,*) ' at_i     ', at_i(ji,jj) 
    340                         WRITE(numout,*) ' Point - category', ji, jj, jl 
    341                         WRITE(numout,*) 
    342                         WRITE(numout,*) ' a_i *** a_i_old ', a_i(ji,jj,jl), old_a_i(ji,jj,jl) 
    343                         WRITE(numout,*) ' v_i *** v_i_old ', v_i(ji,jj,jl), old_v_i(ji,jj,jl) 
    344                         WRITE(numout,*) ' d_a_i_thd/trp   ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 
    345                         WRITE(numout,*) ' d_v_i_thd/trp   ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl) 
    346                         numal(alert_id) = numal(alert_id) + 1 
    347                      ENDIF 
    348                END DO 
    349             END DO 
    350          END DO 
    351  
    352          ! Alerte if very thick ice 
    353          alert_id = 3 ! reference number of this alert 
    354          alname(alert_id) = ' Very thick ice               ' ! name of the alert 
    355          jl = jpl  
     233         ! 
     234         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 3, ' - Final state lim_sbc - ' )   ! control print 
     235         ! 
     236         !                                           ! Diagnostics and outputs  
     237                          !                               ! Ice Diagnostics  
     238         IF( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 )   CALL lim_dia  
     239                          CALL lim_wri( 1  )              ! Ice outputs  
     240         IF( lrst_ice )   CALL lim_rst_write( kt )        ! Ice restart file  
     241                          CALL lim_var_glo2eqv            ! ??? 
     242         ! 
     243         IF( ln_nicep )   CALL lim_ctl               ! alerts in case of model crash 
     244         ! 
     245      ENDIF                                          ! End sea-ice time step only 
     246 
     247      !                                              !--------------------------! 
     248      ! Ice/Ocean stresses (nn_ico_cpl=1 or 2 cases) !  at all ocean time step  ! 
     249      !                                              !--------------------------! 
     250      IF( ln_limdyn .AND. nn_ico_cpl /= 0 )   & 
     251         &                CALL lim_sbc_tau( kt, nn_ico_cpl )  
     252!!gm   remark, in this case the ocean-ice stress is not saved in diag call above .....  find a solution!!! 
     253      ! 
     254   END SUBROUTINE sbc_ice_lim 
     255 
     256 
     257   SUBROUTINE lim_ctl 
     258      !!----------------------------------------------------------------------- 
     259      !!                   ***  ROUTINE lim_ctl ***  
     260      !!                  
     261      !! ** Purpose :   Alerts in case of model crash 
     262      !!------------------------------------------------------------------- 
     263      INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices 
     264      INTEGER  ::   inb_altests       ! number of alert tests (max 20) 
     265      INTEGER  ::   ialert_id         ! number of the current alert 
     266      REAL(wp) ::   ztmelts           ! ice layer melting point 
     267      CHARACTER (len=30), DIMENSION(20)      ::   cl_alname   ! name of alert 
     268      INTEGER           , DIMENSION(20)      ::   inb_alp     ! number of alerts positive 
     269      !!------------------------------------------------------------------- 
     270 
     271      inb_altests = 10 
     272      inb_alp(:) = 0 
     273 
     274      ! Alert if incompatible volume and concentration 
     275      ialert_id = 2 ! reference number of this alert 
     276      cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert 
     277 
     278      DO jl = 1, jpl 
    356279         DO jj = 1, jpj 
    357280            DO ji = 1, jpi 
    358                IF (ht_i(ji,jj,jl) .GT. 50.0 ) THEN 
    359                   WRITE(numout,*) ' ALERTE 3 ' 
    360                   WRITE(numout,*) ' Very thick ice ' 
    361                   CALL lim_inst_state(ji,jj,2) 
    362                   WRITE(numout,*) ' ' 
    363                   numal(alert_id) = numal(alert_id) + 1 
     281               IF(  v_i(ji,jj,jl) /= 0.e0   .AND.   a_i(ji,jj,jl) == 0.e0   ) THEN 
     282                  WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration ' 
     283                  WRITE(numout,*) ' at_i     ', at_i(ji,jj) 
     284                  WRITE(numout,*) ' Point - category', ji, jj, jl 
     285                  WRITE(numout,*) ' a_i *** a_i_old ', a_i      (ji,jj,jl), old_a_i  (ji,jj,jl) 
     286                  WRITE(numout,*) ' v_i *** v_i_old ', v_i      (ji,jj,jl), old_v_i  (ji,jj,jl) 
     287                  WRITE(numout,*) ' d_a_i_thd/trp   ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 
     288                  WRITE(numout,*) ' d_v_i_thd/trp   ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl) 
     289                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    364290               ENDIF 
    365291            END DO 
    366292         END DO 
    367  
    368          ! Alert if very fast ice 
    369          alert_id = 4 ! reference number of this alert 
    370          alname(alert_id) = ' Very fast ice               ' ! name of the alert 
     293      END DO 
     294 
     295      ! Alerte if very thick ice 
     296      ialert_id = 3 ! reference number of this alert 
     297      cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert 
     298      jl = jpl  
     299      DO jj = 1, jpj 
     300         DO ji = 1, jpi 
     301            IF(   ht_i(ji,jj,jl) .GT. 50.0   ) THEN 
     302               CALL lim_prt_state( ji, jj, 2, ' ALERTE 3 :   Very thick ice ' ) 
     303               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     304            ENDIF 
     305         END DO 
     306      END DO 
     307 
     308      ! Alert if very fast ice 
     309      ialert_id = 4 ! reference number of this alert 
     310      cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert 
     311      DO jj = 1, jpj 
     312         DO ji = 1, jpi 
     313            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) .GT. 0.5  .AND.  & 
     314               &  at_i(ji,jj) .GT. 0.e0   ) THEN 
     315               CALL lim_prt_state( ji, jj, 1, ' ALERTE 4 :   Very fast ice ' ) 
     316               WRITE(numout,*) ' ice strength             : ', strength(ji,jj) 
     317               WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj)  
     318               WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj) 
     319               WRITE(numout,*) ' sea-ice stress utaui_ice : ', utaui_ice(ji,jj)  
     320               WRITE(numout,*) ' sea-ice stress vtaui_ice : ', vtaui_ice(ji,jj) 
     321               WRITE(numout,*) ' oceanic speed u          : ', u_oce(ji,jj) 
     322               WRITE(numout,*) ' oceanic speed v          : ', v_oce(ji,jj) 
     323               WRITE(numout,*) ' sst                      : ', sst_m(ji,jj) 
     324               WRITE(numout,*) ' sss                      : ', sss_m(ji,jj) 
     325               WRITE(numout,*)  
     326               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     327            ENDIF 
     328         END DO 
     329      END DO 
     330 
     331      ! Alert if there is ice on continents 
     332      ialert_id = 6 ! reference number of this alert 
     333      cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert 
     334      DO jj = 1, jpj 
     335         DO ji = 1, jpi 
     336            IF(   tms(ji,jj) .LE. 0.0   .AND.   at_i(ji,jj) .GT. 0.e0   ) THEN  
     337               CALL lim_prt_state( ji, jj, 1, ' ALERTE 6 :   Ice on continents ' ) 
     338               WRITE(numout,*) ' masks s, u, v        : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj)  
     339               WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
     340               WRITE(numout,*) ' sss                  : ', sss_m(ji,jj) 
     341               WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj) 
     342               WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj) 
     343               WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1) 
     344               WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj) 
     345               WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj) 
     346               ! 
     347               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     348            ENDIF 
     349         END DO 
     350      END DO 
     351 
     352! 
     353!     ! Alert if very fresh ice 
     354      ialert_id = 7 ! reference number of this alert 
     355      cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert 
     356      DO jl = 1, jpl 
    371357         DO jj = 1, jpj 
    372358            DO ji = 1, jpi 
    373                IF ( ( ( ABS( u_ice(ji,jj) ) .GT. 0.50) .OR. & 
    374                       ( ABS( v_ice(ji,jj) ) .GT. 0.50) ) .AND. & 
    375                     ( at_i(ji,jj) .GT. 0.0 ) ) THEN 
    376                   WRITE(numout,*) ' ALERTE 4 ' 
    377                   WRITE(numout,*) ' Very fast ice ' 
    378                   CALL lim_inst_state(ji,jj,1) 
    379                   WRITE(numout,*) ' ice strength             : ', strength(ji,jj) 
    380                   WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj)  
    381                   WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj) 
    382                   WRITE(numout,*) ' sea-ice stress utaui_ice : ', utaui_ice(ji,jj)  
    383                   WRITE(numout,*) ' sea-ice stress vtaui_ice : ', vtaui_ice(ji,jj) 
    384                   WRITE(numout,*) ' oceanic speed u          : ', u_oce(ji,jj) 
    385                   WRITE(numout,*) ' oceanic speed v          : ', v_oce(ji,jj) 
    386                   WRITE(numout,*) ' sst                      : ', sst_m(ji,jj) 
    387                   WRITE(numout,*) ' sss                      : ', sss_m(ji,jj) 
    388                   WRITE(numout,*)  
    389                   numal(alert_id) = numal(alert_id) + 1 
    390                ENDIF 
    391             END DO 
    392          END DO 
    393  
    394          ! Alert if there is ice on continents 
    395          alert_id = 6 ! reference number of this alert 
    396          alname(alert_id) = ' Ice on continents           ' ! name of the alert 
    397          DO jj = 1, jpj 
    398             DO ji = 1, jpi 
    399                IF ( ( tms(ji,jj) .LE. 0.0 ) .AND. ( at_i(ji,jj) .GT. 0.0 ) ) THEN  
    400                   WRITE(numout,*) ' ALERTE 6 ' 
    401                   WRITE(numout,*) ' Ice on continents ' 
    402                   CALL lim_inst_state(ji,jj,1) 
    403                   WRITE(numout,*) ' masks s, u, v        : ', tms(ji,jj), & 
    404                                                               tmu(ji,jj), & 
    405                                                               tmv(ji,jj)  
    406                   WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
    407                   WRITE(numout,*) ' sss                  : ', sss_m(ji,jj) 
    408                   WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj) 
    409                   WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj) 
    410                   WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1) 
    411                   WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj) 
    412                   WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj) 
    413  
    414                   numal(alert_id) = numal(alert_id) + 1 
    415  
    416                ENDIF 
    417             END DO 
    418          END DO 
    419  
    420          ! Alert if very fresh ice 
    421          alert_id = 7 ! reference number of this alert 
    422          alname(alert_id) = ' Very fresh ice               ' ! name of the alert 
    423          DO jl = 1, jpl 
    424          DO jj = 1, jpj 
    425             DO ji = 1, jpi 
    426                IF ( ( ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) .OR. & 
    427                       ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) ) .AND. & 
    428                     ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 
    429 !                 WRITE(numout,*) ' ALERTE 7 ' 
    430 !                 WRITE(numout,*) ' Very fresh ice ' 
    431 !                 CALL lim_inst_state(ji,jj,1) 
     359!!gm  test twice sm_i ...  ????  bug? 
     360               IF( ( ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) .OR. & 
     361                     ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) ) .AND. & 
     362                             ( a_i(ji,jj,jl) .GT. 0.e0 ) ) THEN 
     363!                 CALL lim_prt_state(ji,jj,1, ' ALERTE 7 :   Very fresh ice ' ) 
    432364!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
    433365!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj) 
    434366!                 WRITE(numout,*) ' s_i_newice           : ', s_i_newice(ji,jj,1:jpl) 
    435367!                 WRITE(numout,*)  
    436                   numal(alert_id) = numal(alert_id) + 1 
     368                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    437369               ENDIF 
    438370            END DO 
    439371         END DO 
    440          END DO 
    441  
    442          ! Alert if too old ice 
    443          alert_id = 9 ! reference number of this alert 
    444          alname(alert_id) = ' Very old   ice               ' ! name of the alert 
    445          DO jl = 1, jpl 
     372      END DO 
     373! 
     374 
     375!     ! Alert if too old ice 
     376      ialert_id = 9 ! reference number of this alert 
     377      cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert 
     378      DO jl = 1, jpl 
    446379         DO jj = 1, jpj 
    447380            DO ji = 1, jpi 
    448381               IF ( ( ( ABS( o_i(ji,jj,jl) ) .GT. rdt_ice ) .OR. & 
    449382                      ( ABS( o_i(ji,jj,jl) ) .LT. 0.00) ) .AND. & 
    450                     ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 
    451                   WRITE(numout,*) ' ALERTE 9 ' 
    452                   WRITE(numout,*) ' Wrong ice age ' 
    453                   CALL lim_inst_state(ji,jj,1) 
    454                   WRITE(numout,*)  
    455                   numal(alert_id) = numal(alert_id) + 1 
     383                             ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 
     384                  CALL lim_prt_state( ji, jj, 1, ' ALERTE 9 :   Wrong ice age ') 
     385                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    456386               ENDIF 
    457387            END DO 
    458388         END DO 
    459  
    460          END DO 
    461  
    462          ! Alert on salt flux 
    463          alert_id = 5 ! reference number of this alert 
    464          alname(alert_id) = ' High salt flux               ' ! name of the alert 
    465          DO jj = 1, jpj 
    466             DO ji = 1, jpi 
    467                IF (ABS(emps(ji,jj)).gt.1.0e-2) THEN 
    468                WRITE(numout,*) ' ALERTE 5 ' 
    469                WRITE(numout,*) ' High salt flux ' 
    470                CALL lim_inst_state(ji,jj,3) 
    471                WRITE(numout,*) ' ' 
     389      END DO 
     390  
     391      ! Alert on salt flux 
     392      ialert_id = 5 ! reference number of this alert 
     393      cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert 
     394      DO jj = 1, jpj 
     395         DO ji = 1, jpi 
     396            IF( ABS( emps(ji,jj) ) .GT. 1.0e-2 ) THEN 
     397               CALL lim_prt_state( ji, jj, 3, ' ALERTE 5 :   High salt flux ' ) 
    472398               DO jl = 1, jpl 
    473399                  WRITE(numout,*) ' Category no: ', jl 
    474                   WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)     , & 
    475                                   ' old_a_i    : ', old_a_i(ji,jj,jl)    
    476                   WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl) , & 
    477                                   ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl)  
    478                   WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)    , & 
    479                                   ' old_v_i    : ', old_v_i(ji,jj,jl)    
    480                   WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl) , & 
    481                                   ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl)  
     400                  WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' old_a_i    : ', old_a_i  (ji,jj,jl)    
     401                  WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl)  
     402                  WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' old_v_i    : ', old_v_i  (ji,jj,jl)    
     403                  WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl)  
    482404                  WRITE(numout,*) ' ' 
    483                   END DO 
    484                   numal(alert_id) = numal(alert_id) + 1 
    485                ENDIF 
     405               END DO 
     406               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     407            ENDIF 
     408         END DO 
     409      END DO 
     410 
     411      ! Alert if qns very big 
     412      ialert_id = 8 ! reference number of this alert 
     413      cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert 
     414      DO jj = 1, jpj 
     415         DO ji = 1, jpi 
     416            IF(   ABS( qns(ji,jj) ) .GT. 1500.0   .AND.  ( at_i(ji,jj) .GT. 0.0 ) )  THEN 
     417               ! 
     418               WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux' 
     419               WRITE(numout,*) ' ji, jj    : ', ji, jj 
     420               WRITE(numout,*) ' qns       : ', qns(ji,jj) 
     421               WRITE(numout,*) ' sst       : ', sst_m(ji,jj) 
     422               WRITE(numout,*) ' sss       : ', sss_m(ji,jj) 
     423               WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) 
     424               WRITE(numout,*) ' qldif     : ', qldif(ji,jj) 
     425               WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) / rdt_ice 
     426               WRITE(numout,*) ' qldif     : ', qldif(ji,jj) / rdt_ice 
     427               WRITE(numout,*) ' qfvbq     : ', qfvbq(ji,jj) 
     428               WRITE(numout,*) ' qdtcn     : ', qdtcn(ji,jj) 
     429               WRITE(numout,*) ' qfvbq / dt: ', qfvbq(ji,jj) / rdt_ice 
     430               WRITE(numout,*) ' qdtcn / dt: ', qdtcn(ji,jj) / rdt_ice 
     431               WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj)  
     432               WRITE(numout,*) ' fhmec     : ', fhmec(ji,jj)  
     433               WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(ji,jj)  
     434               WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj)  
     435               WRITE(numout,*) ' fhbri     : ', fhbri(ji,jj)  
     436               ! 
     437               CALL lim_prt_state( ji, jj, 2, '   ') 
     438               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     439               ! 
     440            ENDIF 
     441         END DO 
     442      END DO 
     443      !+++++ 
     444  
     445      ! Alert if very warm ice 
     446      ialert_id = 10 ! reference number of this alert 
     447      cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert 
     448      inb_alp(ialert_id) = 0 
     449      DO jl = 1, jpl 
     450         DO jk = 1, nlay_i 
     451            DO jj = 1, jpj 
     452               DO ji = 1, jpi 
     453                  ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rtt 
     454                  IF( t_i(ji,jj,jk,jl) .GE. ztmelts  .AND.  v_i(ji,jj,jl) .GT. 1.e-6   & 
     455                     &                               .AND.  a_i(ji,jj,jl) .GT. 0.e0    ) THEN 
     456                     WRITE(numout,*) ' ALERTE 10 :   Very warm ice' 
     457                     WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 
     458                     WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl) 
     459                     WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 
     460                     WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl) 
     461                     WRITE(numout,*) ' ztmelts : ', ztmelts 
     462                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     463                  ENDIF 
     464               END DO 
    486465            END DO 
    487466         END DO 
    488  
    489          ! Alert if qns very big 
    490          alert_id = 8 ! reference number of this alert 
    491          alname(alert_id) = ' qns very big             ' ! name of the alert 
    492          DO jj = 1, jpj 
    493             DO ji = 1, jpi 
    494                IF ( ( ABS( qns(ji,jj) ) .GT. 1500.0 ) .AND. & 
    495                     ( at_i(ji,jj) .GT. 0.0 ) )  THEN 
    496  
    497                   WRITE(numout,*) ' ALERTE 8 ' 
    498                   WRITE(numout,*) ' ji, jj    : ', ji, jj 
    499                   WRITE(numout,*) ' qns       : ', qns(ji,jj) 
    500                   WRITE(numout,*) ' Very high non-solar heat flux ' 
    501                   WRITE(numout,*) ' sst       : ', sst_m(ji,jj) 
    502                   WRITE(numout,*) ' sss       : ', sss_m(ji,jj) 
    503                   WRITE(numout,*) ' qcmif     : ', qcmif(jiindx,jjindx) 
    504                   WRITE(numout,*) ' qldif     : ', qldif(jiindx,jjindx) 
    505                   WRITE(numout,*) ' qcmif     : ', qcmif(jiindx,jjindx) / rdt_ice 
    506                   WRITE(numout,*) ' qldif     : ', qldif(jiindx,jjindx) / rdt_ice 
    507                   WRITE(numout,*) ' qfvbq     : ', qfvbq(jiindx,jjindx) 
    508                   WRITE(numout,*) ' qdtcn     : ', qdtcn(jiindx,jjindx) 
    509                   WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) / rdt_ice 
    510                   WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) / rdt_ice 
    511                   WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx)  
    512                   WRITE(numout,*) ' fhmec     : ', fhmec(jiindx,jjindx)  
    513                   WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(jiindx,jjindx)  
    514                   WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx)  
    515                   WRITE(numout,*) ' fhbri     : ', fhbri(jiindx,jjindx)  
    516  
    517                   CALL lim_inst_state(ji,jj,2) 
    518                   numal(alert_id) = numal(alert_id) + 1 
    519  
    520                ENDIF 
    521             END DO 
    522          END DO 
    523          !+++++ 
     467      END DO 
     468 
     469      ialert_id = 1                                 ! reference number of this alert 
     470      cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert 
     471      WRITE(numout,*) 
     472      WRITE(numout,*) ' All alerts at the end of ice model ' 
     473      DO ialert_id = 1, inb_altests 
     474         WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! ' 
     475      END DO 
     476      ! 
     477   END SUBROUTINE lim_ctl 
    524478  
    525          ! Alert if very warm ice 
    526          alert_id = 10 ! reference number of this alert 
    527          alname(alert_id) = ' Very warm ice                ' ! name of the alert 
    528          numal(alert_id) = 0 
    529          DO jl = 1, jpl 
    530          DO jk = 1, nlay_i 
    531          DO jj = 1, jpj 
    532             DO ji = 1, jpi 
    533                ztmelts    =  -tmut*s_i(ji,jj,jk,jl) + rtt 
    534                IF ( ( t_i(ji,jj,jk,jl) .GE. ztmelts) .AND. & 
    535                     ( v_i(ji,jj,jl)   .GT. 1.0e-6)   .AND. & 
    536                     ( a_i(ji,jj,jl) .GT. 0.0     )  ) THEN 
    537                   WRITE(numout,*) ' ALERTE 10 ' 
    538                   WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 
    539                   WRITE(numout,*) ' Very warm ice ' 
    540                   WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl) 
    541                   WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 
    542                   WRITE(numout,*) ' s_i : ', s_i(ji,jj,jk,jl) 
    543                   WRITE(numout,*) ' ztmelts : ', ztmelts 
    544                   numal(alert_id) = numal(alert_id) + 1 
    545                ENDIF 
    546             END DO 
    547          END DO 
    548          END DO 
    549          END DO 
    550  
    551          alert_id = 1 ! reference number of this alert 
    552          alname(alert_id) = ' Il n''y a pas d''alerte 1       ' ! name of the alert 
    553          WRITE(numout,*) 
    554          WRITE(numout,*) ' All alerts at the end of ice model ' 
    555          DO alert_id = 1, numaltests 
    556             WRITE(numout,*) alert_id, alname(alert_id)//' : ', numal(alert_id), ' times ! ' 
    557          END DO 
    558          ! 
    559       ENDIF  ! End sea-ice coupling 
    560       ! 
    561    END SUBROUTINE sbc_ice_lim 
    562  
    563  
    564    SUBROUTINE lim_inst_state( ki, kj, kn ) 
     479    
     480   SUBROUTINE lim_prt_state( ki, kj, kn, cd1 ) 
    565481      !!----------------------------------------------------------------------- 
    566       !!                   ***  ROUTINE lim_inst_state ***  
     482      !!                   ***  ROUTINE lim_prt_state ***  
    567483      !!                  
    568484      !! ** Purpose :   Writes global ice state on the (i,j) point  
    569485      !!                in ocean.ouput  
    570486      !!                3 possibilities exist  
    571       !!                n = 1 -> simple ice state 
    572       !!                n = 2 -> exhaustive state 
    573       !!                n = 3 -> ice/ocean salt fluxes 
     487      !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1) 
     488      !!                n = 2    -> exhaustive state 
     489      !!                n = 3    -> ice/ocean salt fluxes 
    574490      !! 
    575491      !! ** input   :   point coordinates (i,j)  
    576492      !!                n : number of the option 
    577493      !!------------------------------------------------------------------- 
    578       INTEGER, INTENT( in ) ::   ki, kj, kn     ! ocean time-step index 
     494      INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices 
     495      CHARACTER(len=*), INTENT(in) ::   cd1           ! 
     496      !! 
    579497      INTEGER :: jl 
    580498      !!------------------------------------------------------------------- 
     499 
     500      WRITE(numout,*) cd1             ! print title 
    581501 
    582502      !---------------- 
    … …  
    584504      !---------------- 
    585505 
    586       IF ( kn .EQ. 1 ) THEN 
    587          WRITE(numout,*) ' lim_inst_state - Point : ',ki,kj 
     506      IF ( kn == 1 .OR. kn == -1 ) THEN 
     507         WRITE(numout,*) ' lim_prt_state - Point : ',ki,kj 
    588508         WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 
    589509         WRITE(numout,*) ' Simple state ' 
    … …  
    623543         END DO 
    624544      ENDIF 
     545      IF( kn == -1 ) THEN 
     546         WRITE(numout,*) ' Mechanical Check ************** ' 
     547         WRITE(numout,*) ' Check what means ice divergence ' 
     548         WRITE(numout,*) ' Total ice concentration ', at_i (ki,kj) 
     549         WRITE(numout,*) ' Total lead fraction     ', ato_i(ki,kj) 
     550         WRITE(numout,*) ' Sum of both             ', ato_i(ki,kj) + at_i(ki,kj) 
     551         WRITE(numout,*) ' Sum of both minus 1     ', ato_i(ki,kj) + at_i(ki,kj) - 1.00 
     552      ENDIF 
     553 
    625554 
    626555      !-------------------- 
    … …  
    629558 
    630559      IF ( kn .EQ. 2 ) THEN 
    631          WRITE(numout,*) ' lim_inst_state - Point : ',ki,kj 
     560         WRITE(numout,*) ' lim_prt_state - Point : ',ki,kj 
    632561         WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 
    633562         WRITE(numout,*) ' Exhaustive state ' 
    … …  
    705634 
    706635     IF ( kn .EQ. 3 ) THEN 
    707         WRITE(numout,*) ' lim_inst_state - Point : ',ki,kj 
     636        WRITE(numout,*) ' lim_prt_state - Point : ',ki,kj 
    708637        WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' 
    709638        WRITE(numout,*) ' - Salt / Heat Fluxes ' 
    … …  
    730659        WRITE(numout,*) ' vtau      : ', vtau(ki,kj) 
    731660      ENDIF 
    732  
    733    END SUBROUTINE lim_inst_state 
     661      WRITE(numout,*) ' ' 
     662      ! 
     663   END SUBROUTINE lim_prt_state 
    734664 
    735665#else 
Note: See TracChangeset for help on using the changeset viewer.