Ignore:
Timestamp:
2019-10-12T16:08:18+02:00 (15 months ago)
Author:
francesca
Message:

Update branch to integrate the development starting from the current v4.01 ready trunk

Location:
NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src
Files:
2 deleted
180 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/ice.F90

    r10882 r11692  
    102102   !! vt_i        |      -      |    Total ice vol. per unit area | m     | 
    103103   !! vt_s        |      -      |    Total snow vol. per unit ar. | m     | 
     104   !! st_i        |      -      |    Total Sea ice salt content   | pss.m | 
    104105   !! sm_i        |      -      |    Mean sea ice salinity        | pss   | 
    105106   !! tm_i        |      -      |    Mean sea ice temperature     | K     | 
    … …  
    109110   !! bv_i        |      -      |    relative brine volume        | ???   |  
    110111   !! at_ip       |      -      |    Total ice pond concentration |       | 
     112   !! hm_ip       |      -      |    Mean ice pond depth          | m     | 
    111113   !! vt_ip       |      -      |    Total ice pond vol. per unit area| m | 
    112114   !!===================================================================== 
    … …  
    135137   REAL(wp), PUBLIC ::   rn_ishlat        !: lateral boundary condition for sea-ice 
    136138   LOGICAL , PUBLIC ::   ln_landfast_L16  !: landfast ice parameterizationfrom lemieux2016  
    137    LOGICAL , PUBLIC ::   ln_landfast_home !: landfast ice parameterizationfrom home made  
    138139   REAL(wp), PUBLIC ::   rn_depfra        !:    fraction of ocean depth that ice must reach to initiate landfast ice 
    139140   REAL(wp), PUBLIC ::   rn_icebfr        !:    maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home)  
    … …  
    188189 
    189190   !                                     !!** ice-ponds namelist (namthd_pnd) 
     191   LOGICAL , PUBLIC ::   ln_pnd           !: Melt ponds (T) or not (F) 
    190192   LOGICAL , PUBLIC ::   ln_pnd_H12       !: Melt ponds scheme from Holland et al 2012 
    191193   LOGICAL , PUBLIC ::   ln_pnd_CST       !: Melt ponds scheme with constant fraction and depth 
    … …  
    196198   !                                     !!** ice-diagnostics namelist (namdia) ** 
    197199   LOGICAL , PUBLIC ::   ln_icediachk     !: flag for ice diag (T) or not (F) 
     200   REAL(wp), PUBLIC ::   rn_icechk_cel    !: rate of ice spuriously gained/lost (at any gridcell) 
     201   REAL(wp), PUBLIC ::   rn_icechk_glo    !: rate of ice spuriously gained/lost (globally) 
    198202   LOGICAL , PUBLIC ::   ln_icediahsb     !: flag for ice diag (T) or not (F) 
    199203   LOGICAL , PUBLIC ::   ln_icectl        !: flag for sea-ice points output (T) or not (F) 
    … …  
    213217   REAL(wp), PUBLIC, PARAMETER ::   epsi20 = 1.e-20_wp  !: small number  
    214218 
    215    !                                     !!** some other parameters for advection using the ULTIMATE-MACHO scheme 
    216    LOGICAL, PUBLIC, DIMENSION(2) :: l_split_advumx = .FALSE.    ! force one iteration at the first time-step 
    217  
    218219   !                                     !!** define arrays 
    219220   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce,v_oce !: surface ocean velocity used in ice dynamics 
    … …  
    251252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res     !: mass flux from residual component of wfx_ice             [kg.m-2.s-1] 
    252253   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_err_sub !: mass flux error after sublimation                        [kg.m-2.s-1] 
    253  
    254    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total)        [s-1] 
    255254 
    256255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice bottom growth                   [pss.kg.m-2.s-1 => g.m-2.s-1] 
    … …  
    309308   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice !: components of the ice velocity                          (m/s) 
    310309   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vt_i , vt_s  !: ice and snow total volume per unit area                 (m) 
     310   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   st_i         !: Total ice salinity content                              (pss.m) 
    311311   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i         !: ice total fractional area (ice concentration) 
    312312   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ato_i        !: =1-at_i ; total open water fractional area 
    … …  
    328328   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sz_i     !: ice salinity          [PSS] 
    329329 
    330    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip       !: melt pond fraction per grid cell area 
     330   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip       !: melt pond concentration 
    331331   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_ip       !: melt pond volume per grid cell area      [m] 
    332    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip_frac  !: melt pond volume per ice area 
    333    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_ip       !: melt pond thickness                      [m] 
    334  
    335    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   at_ip      !: total melt pond fraction 
    336    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vt_ip      !: total melt pond volume per unit area     [m] 
     332   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip_frac  !: melt pond fraction (a_ip/a_i) 
     333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_ip       !: melt pond depth                          [m] 
     334 
     335   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   at_ip      !: total melt pond concentration 
     336   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hm_ip      !: mean melt pond depth                     [m] 
     337   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vt_ip      !: total melt pond volume per gridcell area [m] 
    337338 
    338339   !!---------------------------------------------------------------------- 
    … …  
    355356   !! * Ice diagnostics 
    356357   !!---------------------------------------------------------------------- 
    357    ! thd refers to changes induced by thermodynamics 
    358    ! trp   ''         ''     ''       advection (transport of ice) 
    359    ! 
    360358   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vi   !: transport of ice volume 
    361359   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vs   !: transport of snw volume 
    … …  
    369367   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vsnw     !: snw volume variation   [m/s]  
    370368 
     369   !!---------------------------------------------------------------------- 
     370   !! * Ice conservation 
     371   !!---------------------------------------------------------------------- 
     372   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_v        !: conservation of ice volume 
     373   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_s        !: conservation of ice salt 
     374   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_t        !: conservation of ice heat 
     375   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fv       !: conservation of ice volume 
     376   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fs       !: conservation of ice salt 
     377   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_ft       !: conservation of ice heat 
    371378   ! 
    372379   !!---------------------------------------------------------------------- 
    … …  
    393400      INTEGER :: ice_alloc 
    394401      ! 
    395       INTEGER :: ierr(15), ii 
     402      INTEGER :: ierr(16), ii 
    396403      !!----------------------------------------------------------------- 
    397404      ierr(:) = 0 
    … …  
    409416         &      wfx_bog    (jpi,jpj) , wfx_dyn   (jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,           & 
    410417         &      wfx_res    (jpi,jpj) , wfx_sni   (jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,           & 
    411          &      afx_tot    (jpi,jpj) , rn_amax_2d(jpi,jpj),                                                  & 
     418         &      rn_amax_2d (jpi,jpj) ,                                                                       & 
    412419         &      qsb_ice_bot(jpi,jpj) , qlead     (jpi,jpj) ,                                                 & 
    413420         &      sfx_res    (jpi,jpj) , sfx_bri   (jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) ,  & 
    … …  
    429436      ii = ii + 1 
    430437      ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) ,                                   & 
    431          &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) ,  & 
    432          &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s (jpi,jpj) ,  & 
    433          &      sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s (jpi,jpj) ,  & 
     438         &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , st_i(jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) ,  & 
     439         &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s(jpi,jpj) ,  & 
     440         &      sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) ,  & 
    434441         &      om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj)            , STAT=ierr(ii) ) 
    435442 
    … …  
    444451 
    445452      ii = ii + 1 
    446       ALLOCATE( at_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 
     453      ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 
    447454 
    448455      ! * Old values of global variables 
    … …  
    465472         &      diag_sice  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), STAT=ierr(ii) ) 
    466473 
     474      ! * Ice conservation 
     475      ii = ii + 1 
     476      ALLOCATE( diag_v (jpi,jpj) , diag_s (jpi,jpj) , diag_t (jpi,jpj),   &  
     477         &      diag_fv(jpi,jpj) , diag_fs(jpi,jpj) , diag_ft(jpi,jpj), STAT=ierr(ii) ) 
     478       
    467479      ! * SIMIP diagnostics 
    468480      ii = ii + 1 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icealb.F90

    r10535 r11692  
    192192      REWIND( numnam_ice_ref )              ! Namelist namalb in reference namelist : Albedo parameters 
    193193      READ  ( numnam_ice_ref, namalb, IOSTAT = ios, ERR = 901) 
    194 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namalb in reference namelist', lwp ) 
     194901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namalb in reference namelist' ) 
    195195      REWIND( numnam_ice_cfg )              ! Namelist namalb in configuration namelist : Albedo parameters 
    196196      READ  ( numnam_ice_cfg, namalb, IOSTAT = ios, ERR = 902 ) 
    197 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namalb in configuration namelist', lwp ) 
     197902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namalb in configuration namelist' ) 
    198198      IF(lwm) WRITE( numoni, namalb ) 
    199199      ! 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icecor.F90

    r10994 r11692  
    1717   USE phycst         ! physical constants 
    1818   USE ice            ! sea-ice: variable 
    19    USE ice1D          ! sea-ice: thermodynamic sea-ice variables 
     19   USE ice1D          ! sea-ice: thermodynamic variables 
    2020   USE iceitd         ! sea-ice: rebining 
    2121   USE icevar         ! sea-ice: operations 
    … …  
    6060      IF( ln_timing    )   CALL timing_start('icecor')                                                             ! timing 
    6161      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
     62      IF( ln_icediachk )   CALL ice_cons2D  (0, 'icecor',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    6263      ! 
    6364      IF( kt == nit000 .AND. lwp .AND. kn == 2 ) THEN 
    … …  
    7879      !                             !----------------------------------------------------- 
    7980      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    80       DO jl  = 1, jpl 
     81      DO jl = 1, jpl 
    8182         WHERE( at_i(:,:) > rn_amax_2d(:,:) )   a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) 
    8283      END DO 
    … …  
    8485      !                             !----------------------------------------------------- 
    8586      IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        ! 
    86       !                             !----------------------------------------------------- 
     87         !                          !----------------------------------------------------- 
    8788         zzc = rhoi * r1_rdtice 
    8889         DO jl = 1, jpl 
    … …  
    117118            END DO 
    118119         END DO 
    119          CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. )            ! lateral boundary conditions 
     120         CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) 
    120121      ENDIF 
    121122 
    122 !!gm I guess the trends are only out on demand  
    123 !!   So please, only do this is it exite an iom_use of on a these variables 
    124 !!   furthermore, only allocate the diag_ arrays in this case  
    125 !!   and do the iom_put here so that it is only a local allocation 
    126 !!gm  
    127123      !                             !----------------------------------------------------- 
    128124      SELECT CASE( kn )             !  Diagnostics                                       ! 
    … …  
    130126      CASE( 1 )                        !--- dyn trend diagnostics 
    131127         ! 
    132 !!gm   here I think the number of ice cat is too small to use a SUM instruction... 
    133          DO jj = 1, jpj 
    134             DO ji = 1, jpi             
    135                !                 ! heat content variation (W.m-2) 
    136                diag_heat(ji,jj) = - (  SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) )    &  
    137                   &                  + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_rdtice 
    138                !                 ! salt, volume 
    139                diag_sice(ji,jj) = SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_rdtice 
    140                diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_rdtice 
    141                diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_rdtice 
    142             END DO 
    143          END DO 
     128         IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN 
     129            diag_heat(:,:) = - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice &      ! W.m-2 
     130               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice 
     131            diag_sice(:,:) =   SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice * rhoi 
     132            diag_vice(:,:) =   SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhoi 
     133            diag_vsnw(:,:) =   SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhos 
     134         ENDIF 
    144135         !                       ! concentration tendency (dynamics) 
    145          zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice  
    146          afx_tot(:,:) = zafx(:,:) 
    147          IF( iom_use('afxdyn') )   CALL iom_put( 'afxdyn' , zafx(:,:) ) 
     136         IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN  
     137            zafx(:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice  
     138            CALL iom_put( 'afxdyn' , zafx ) 
     139         ENDIF 
    148140         ! 
    149141      CASE( 2 )                        !--- thermo trend diagnostics & ice aging 
    … …  
    151143         oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice   ! ice natural aging incrementation 
    152144         ! 
    153 !!gm   here I think the number of ice cat is too small to use a SUM instruction... 
    154          DO jj = 1, jpj 
    155             DO ji = 1, jpi             
    156                !                 ! heat content variation (W.m-2) 
    157                diag_heat(ji,jj) = diag_heat(ji,jj) - (  SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) )    &  
    158                   &                                   + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_rdtice 
    159                !                 ! salt, volume 
    160                diag_sice(ji,jj) = diag_sice(ji,jj) + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_rdtice 
    161                diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_rdtice 
    162                diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_rdtice 
    163             END DO 
    164          END DO 
     145         IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN 
     146            diag_heat(:,:) = diag_heat(:,:) & 
     147               &             - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice & 
     148               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice 
     149            diag_sice(:,:) = diag_sice(:,:) & 
     150               &             + SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice * rhoi 
     151            diag_vice(:,:) = diag_vice(:,:) & 
     152               &             + SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhoi 
     153            diag_vsnw(:,:) = diag_vsnw(:,:) & 
     154               &             + SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhos 
     155            CALL iom_put ( 'hfxdhc' , diag_heat )  
     156         ENDIF 
    165157         !                       ! concentration tendency (total + thermo) 
    166          zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
    167          afx_tot(:,:) = afx_tot(:,:) + zafx(:,:) 
    168          IF( iom_use('afxthd') )   CALL iom_put( 'afxthd' , zafx(:,:) ) 
    169          IF( iom_use('afxtot') )   CALL iom_put( 'afxtot' , afx_tot(:,:) ) 
     158         IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN  
     159            zafx(:,:) = zafx(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
     160            CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice ) 
     161            CALL iom_put( 'afxtot' , zafx ) 
     162         ENDIF 
    170163         ! 
    171164      END SELECT 
    172165      ! 
    173166      ! controls 
    174       IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
    175       IF( ln_ctl         )   CALL ice_prt3D   ('icecor')                                                             ! prints 
    176       IF( ln_icectl .AND. kn == 2 )   CALL ice_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                   ! prints 
    177       IF( ln_timing      )   CALL timing_stop ('icecor')                                                             ! timing 
     167      IF( ln_ctl       )   CALL ice_prt3D   ('icecor')                                                             ! prints 
     168      IF( ln_icectl .AND. kn == 2 ) & 
     169         &                 CALL ice_prt     ( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                       ! prints 
     170      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
     171      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icecor',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
     172      IF( ln_timing    )   CALL timing_stop ('icecor')                                                             ! timing 
    178173      ! 
    179174   END SUBROUTINE ice_cor 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icectl.F90

    r10994 r11692  
    1212   !!   'key_si3'                                       SI3 sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    !!    ice_cons_hsm     : conservation tests on heat, salt and mass 
    15    !!    ice_cons_final   : conservation tests on heat, salt and mass at end of time step 
     14   !!    ice_cons_hsm     : conservation tests on heat, salt and mass during a  time step (global)  
     15   !!    ice_cons_final   : conservation tests on heat, salt and mass at end of time step (global) 
     16   !!    ice_cons2D       : conservation tests on heat, salt and mass at each gridcell 
    1617   !!    ice_ctl          : control prints in case of crash 
    1718   !!    ice_prt          : control prints at a given grid point 
    … …  
    2728   ! 
    2829   USE in_out_manager ! I/O manager 
     30   USE iom            ! I/O manager library 
    2931   USE lib_mpp        ! MPP library 
    3032   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
    … …  
    3739   PUBLIC   ice_cons_hsm 
    3840   PUBLIC   ice_cons_final 
     41   PUBLIC   ice_cons2D 
    3942   PUBLIC   ice_ctl 
    4043   PUBLIC   ice_prt 
    4144   PUBLIC   ice_prt3D 
    4245 
     46   ! thresold rates for conservation 
     47   !    these values are changed by the namelist parameter rn_icechk, so that threshold = zchk * rn_icechk 
     48   REAL(wp), PARAMETER ::   zchk_m   = 2.5e-7   ! kg/m2/s <=> 1e-6 m of ice per hour spuriously gained/lost 
     49   REAL(wp), PARAMETER ::   zchk_s   = 2.5e-6   ! g/m2/s  <=> 1e-6 m of ice per hour spuriously gained/lost (considering s=10g/kg) 
     50   REAL(wp), PARAMETER ::   zchk_t   = 7.5e-2   ! W/m2    <=> 1e-6 m of ice per hour spuriously gained/lost (considering Lf=3e5J/kg) 
     51    
    4352   !! * Substitutions 
    4453#  include "vectopt_loop_substitute.h90" 
    … …  
    5968      !! ** Method  : This is an online diagnostics which can be activated with ln_icediachk=true 
    6069      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
    61       !!              The thresholds (zv_sill, zs_sill, zt_sill) which determine violations are set to 
    62       !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 
     70      !!              The thresholds (zchk_m, zchk_s, zchk_t) determine violations 
    6371      !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
    6472      !!              and a heat content of 3e5 J/kg (=latent heat of fusion)  
    … …  
    6876      REAL(wp)        , INTENT(inout) ::   pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft 
    6977      !! 
    70       REAL(wp) ::   zv, zs, zt, zfs, zfv, zft 
    71       REAL(wp) ::   zvmin, zamin, zamax, zeimin, zesmin, zsmin 
     78      REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat, & 
     79         &          zdiag_vmin, zdiag_amin, zdiag_amax, zdiag_eimin, zdiag_esmin, zdiag_smin 
    7280      REAL(wp) ::   zvtrp, zetrp 
    73       REAL(wp) ::   zarea, zv_sill, zs_sill, zt_sill 
    74       REAL(wp), PARAMETER ::   zconv = 1.e-9 ! convert W to GW and kg to Mt 
     81      REAL(wp) ::   zarea 
    7582      !!------------------------------------------------------------------- 
    7683      ! 
    7784      IF( icount == 0 ) THEN 
    78          !                          ! water flux 
    79          pdiag_fv = glob_sum( 'icectl',                                                                       & 
    80             &                 -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) +                  & 
    81             &                    wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_lam(:,:) + wfx_pnd(:,:)  +  & 
    82             &                    wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) +  & 
    83             &                    wfx_ice_sub(:,:) + wfx_spr(:,:)  & 
    84             &                  ) * e1e2t(:,:) ) * zconv 
     85 
     86         pdiag_v = glob_sum( 'icectl',   SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) 
     87         pdiag_s = glob_sum( 'icectl',   SUM( sv_i * rhoi            , dim=3 ) * e1e2t ) 
     88         pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t ) 
     89 
     90         ! mass flux 
     91         pdiag_fv = glob_sum( 'icectl',  & 
     92            &                         ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 
     93            &                           wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t ) 
     94         ! salt flux 
     95         pdiag_fs = glob_sum( 'icectl',  & 
     96            &                         ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & 
     97            &                           sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) 
     98         ! heat flux 
     99         pdiag_ft = glob_sum( 'icectl',  & 
     100            &                         (   hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw  & 
     101            &                           - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) 
     102 
     103      ELSEIF( icount == 1 ) THEN 
     104 
     105         ! -- mass diag -- ! 
     106         zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_rdtice       & 
     107            &         + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn +       & 
     108            &                                 wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + & 
     109            &                                 wfx_ice_sub + wfx_spr ) * e1e2t )                                           & 
     110            &         - pdiag_fv 
    85111         ! 
    86          !                          ! salt flux 
    87          pdiag_fs = glob_sum( 'icectl',                                                                     & 
    88             &                  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    89             &                    sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    & 
    90             &                  ) *  e1e2t(:,:) ) * zconv  
     112         ! -- salt diag -- ! 
     113         zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_rdtice  & 
     114            &         + glob_sum( 'icectl', ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni +           & 
     115            &                                 sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) & 
     116            &         - pdiag_fs 
    91117         ! 
    92          !                          ! heat flux 
    93          pdiag_ft = glob_sum( 'icectl',                                                                    & 
    94             &                  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
    95             &                  - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
    96             &                  ) *  e1e2t(:,:) ) * zconv 
    97  
    98          pdiag_v = glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t * zconv ) 
    99  
    100          pdiag_s = glob_sum( 'icectl', SUM( sv_i * rhoi            , dim=3 ) * e1e2t * zconv ) 
    101  
    102          pdiag_t = glob_sum( 'icectl', (  SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )     & 
    103             &                 + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv 
    104  
    105       ELSEIF( icount == 1 ) THEN 
    106  
    107          ! water flux 
    108          zfv = glob_sum( 'icectl',                                                                        & 
    109             &             -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) +                  & 
    110             &                wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_lam(:,:) + wfx_pnd(:,:)  +  & 
    111             &                wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) +  & 
    112             &                wfx_ice_sub(:,:) + wfx_spr(:,:)  & 
    113             &              ) * e1e2t(:,:) ) * zconv - pdiag_fv 
    114  
    115          ! salt flux 
    116          zfs = glob_sum( 'icectl',                                                                       & 
    117             &              ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    118             &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    &  
    119             &              ) * e1e2t(:,:) ) * zconv - pdiag_fs 
    120  
    121          ! heat flux 
    122          zft = glob_sum( 'icectl',                                                                      & 
    123             &              ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
    124             &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
    125             &              ) * e1e2t(:,:) ) * zconv - pdiag_ft 
    126   
    127          ! outputs 
    128          zv = ( ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) * zconv  & 
    129             &     - pdiag_v ) * r1_rdtice - zfv ) * rday 
    130  
    131          zs = ( ( glob_sum( 'icectl', SUM( sv_i * rhoi            , dim=3 ) * e1e2t ) * zconv  & 
    132             &     - pdiag_s ) * r1_rdtice + zfs ) * rday 
    133  
    134          zt = ( glob_sum( 'icectl',                                                                & 
    135             &             (  SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )                       & 
    136             &              + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv   & 
    137             &   - pdiag_t ) * r1_rdtice + zft 
    138  
    139          ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 
    140          zvtrp = glob_sum( 'icectl', ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t  ) * zconv * rday  
    141          zetrp = glob_sum( 'icectl', ( diag_trp_ei        + diag_trp_es        ) * e1e2t  ) * zconv 
    142  
    143          zamax  = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 
    144          zvmin  = glob_min( 'icectl', v_i ) 
    145          zamin  = glob_min( 'icectl', a_i ) 
    146          zsmin  = glob_min( 'icectl', sv_i ) 
    147          zeimin = glob_min( 'icectl', SUM( e_i, dim=3 ) ) 
    148          zesmin = glob_min( 'icectl', SUM( e_s, dim=3 ) ) 
    149  
    150          ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)  
    151          zarea   = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2 
    152          zv_sill = zarea * 2.5e-5 
    153          zs_sill = zarea * 25.e-5 
    154          zt_sill = zarea * 10.e-5 
    155  
    156          IF(lwp) THEN 
     118         ! -- heat diag -- ! 
     119         zdiag_heat = ( glob_sum( 'icectl', ( SUM(SUM(e_i, dim=4), dim=3) + SUM(SUM(e_s, dim=4), dim=3) ) * e1e2t ) - pdiag_t & 
     120            &         ) * r1_rdtice                                                                                           & 
     121            &         + glob_sum( 'icectl', (  hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw                      & 
     122            &                                - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t )                    & 
     123            &         - pdiag_ft 
     124 
     125         ! -- min/max diag -- ! 
     126         zdiag_amax  = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 
     127         zdiag_vmin  = glob_min( 'icectl', v_i ) 
     128         zdiag_amin  = glob_min( 'icectl', a_i ) 
     129         zdiag_smin  = glob_min( 'icectl', sv_i ) 
     130         zdiag_eimin = glob_min( 'icectl', SUM( e_i, dim=3 ) ) 
     131         zdiag_esmin = glob_min( 'icectl', SUM( e_s, dim=3 ) ) 
     132 
     133         ! -- advection scheme is conservative? -- ! 
     134         zvtrp = glob_sum( 'icectl', ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t ) ! must be close to 0 (only for Prather) 
     135         zetrp = glob_sum( 'icectl', ( diag_trp_ei        + diag_trp_es        ) * e1e2t ) ! must be close to 0 (only for Prather) 
     136 
     137         ! ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     138         zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 
     139 
     140         IF( lwp ) THEN 
    157141            ! check conservation issues 
    158             IF ( ABS( zv ) > zv_sill )   WRITE(numout,*) 'violation volume [Mt/day]     (',cd_routine,') = ',zv 
    159             IF ( ABS( zs ) > zs_sill )   WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zs 
    160             IF ( ABS( zt ) > zt_sill )   WRITE(numout,*) 'violation enthalpy [GW]       (',cd_routine,') = ',zt 
     142            IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 
     143               &                   WRITE(numout,*)   cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice 
     144            IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 
     145               &                   WRITE(numout,*)   cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rdt_ice 
     146            IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) & 
     147               &                   WRITE(numout,*)   cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rdt_ice 
     148            ! check negative values 
     149            IF( zdiag_vmin  < 0. ) WRITE(numout,*)   cd_routine,' : violation v_i < 0         = ',zdiag_vmin 
     150            IF( zdiag_amin  < 0. ) WRITE(numout,*)   cd_routine,' : violation a_i < 0         = ',zdiag_amin 
     151            IF( zdiag_smin  < 0. ) WRITE(numout,*)   cd_routine,' : violation s_i < 0         = ',zdiag_smin 
     152            IF( zdiag_eimin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_i < 0         = ',zdiag_eimin 
     153            IF( zdiag_esmin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_s < 0         = ',zdiag_esmin 
    161154            ! check maximum ice concentration 
    162             IF ( zamax > MAX( rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' )  & 
    163                &                         WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
    164             ! check negative values 
    165             IF ( zvmin  < 0. )           WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',zvmin 
    166             IF ( zamin  < 0. )           WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
    167             IF ( zsmin  < 0. )           WRITE(numout,*) 'violation s_i<0               (',cd_routine,') = ',zsmin 
    168             IF ( zeimin < 0. )           WRITE(numout,*) 'violation e_i<0               (',cd_routine,') = ',zeimin 
    169             IF ( zesmin < 0. )           WRITE(numout,*) 'violation e_s<0               (',cd_routine,') = ',zesmin 
    170 !clem: the following check fails (I think...) 
    171 !            IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'icedyn_adv' ) THEN 
    172 !                                           WRITE(numout,*) 'violation vtrp [Mt/day]       (',cd_routine,') = ',zvtrp 
    173 !                                           WRITE(numout,*) 'violation etrp [GW]           (',cd_routine,') = ',zetrp 
    174 !            ENDIF 
     155            IF( zdiag_amax > MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 
     156               &                   WRITE(numout,*)   cd_routine,' : violation a_i > amax      = ',zdiag_amax 
     157            ! check if advection scheme is conservative 
     158            !    only check for Prather because Ultimate-Macho uses corrective fluxes (wfx etc) 
     159            !    so the formulation for conservation is different (and not coded)  
     160            !    it does not mean UM is not conservative (it is checked with above prints) => update (09/2019): same for Prather now 
     161            !IF( ln_adv_Pra .AND. ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
     162            !   &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rdt_ice 
    175163         ENDIF 
    176164         ! 
    … …  
    179167   END SUBROUTINE ice_cons_hsm 
    180168 
    181  
    182169   SUBROUTINE ice_cons_final( cd_routine ) 
    183170      !!------------------------------------------------------------------- 
    … …  
    188175      !! ** Method  : This is an online diagnostics which can be activated with ln_icediachk=true 
    189176      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
    190       !!              The thresholds (zv_sill, zs_sill, zt_sill) which determine the violation are set to 
    191       !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 
     177      !!              The thresholds (zchk_m, zchk_s, zchk_t) determine the violations 
    192178      !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
    193179      !!              and a heat content of 3e5 J/kg (=latent heat of fusion)  
    194180      !!------------------------------------------------------------------- 
    195       CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine 
    196       REAL(wp)                        :: zqmass, zhfx, zsfx, zvfx 
    197       REAL(wp)                        :: zarea, zv_sill, zs_sill, zt_sill 
    198       REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt 
     181      CHARACTER(len=*), INTENT(in) ::   cd_routine    ! name of the routine 
     182      REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat 
     183      REAL(wp) ::   zarea 
    199184      !!------------------------------------------------------------------- 
    200185 
    201186      ! water flux 
    202       zvfx  = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) * zconv * rday 
    203  
    204       ! salt flux 
    205       zsfx  = glob_sum( 'icectl', ( sfx + diag_sice ) * e1e2t ) * zconv * rday 
    206  
    207       ! heat flux 
     187      ! -- mass diag -- ! 
     188      zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) 
     189 
     190      ! -- salt diag -- ! 
     191      zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice ) * e1e2t ) 
     192 
     193      ! -- heat diag -- ! 
    208194      ! clem: not the good formulation 
    209       !!zhfx  = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat + hfx_thd + hfx_dyn + hfx_res + hfx_sub + hfx_spr  & 
    210       !!   &                        ) * e1e2t ) * zconv 
    211  
    212       ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)  
    213       zarea   = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2 
    214       zv_sill = zarea * 2.5e-5 
    215       zs_sill = zarea * 25.e-5 
    216       zt_sill = zarea * 10.e-5 
    217  
    218       IF(lwp) THEN 
    219          IF( ABS( zvfx ) > zv_sill )   WRITE(numout,*) 'violation vfx  [Mt/day]       (',cd_routine,') = ',zvfx 
    220          IF( ABS( zsfx ) > zs_sill )   WRITE(numout,*) 'violation sfx  [psu*Mt/day]   (',cd_routine,') = ',zsfx 
    221          !!IF( ABS( zhfx ) > zt_sill )   WRITE(numout,*) 'violation hfx  [GW]           (',cd_routine,') = ',zhfx 
     195      !!zdiag_heat  = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat + hfx_thd + hfx_dyn + hfx_res + hfx_sub + hfx_spr  & 
     196      !!   &                              ) * e1e2t ) 
     197 
     198      ! ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     199      zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 
     200 
     201      IF( lwp ) THEN 
     202         IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 
     203            &                   WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice 
     204         IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 
     205            &                   WRITE(numout,*) cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rdt_ice 
     206         !!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,*) cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rdt_ice 
    222207      ENDIF 
    223208      ! 
    224209   END SUBROUTINE ice_cons_final 
    225210 
     211   SUBROUTINE ice_cons2D( icount, cd_routine, pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft ) 
     212      !!------------------------------------------------------------------- 
     213      !!                       ***  ROUTINE ice_cons2D *** 
     214      !! 
     215      !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine 
     216      !!                     + test if ice concentration and volume are > 0 
     217      !! 
     218      !! ** Method  : This is an online diagnostics which can be activated with ln_icediachk=true 
     219      !!              It stops the code if there is a violation of conservation at any gridcell 
     220      !!------------------------------------------------------------------- 
     221      INTEGER         , INTENT(in) ::   icount        ! called at: =0 the begining of the routine, =1  the end 
     222      CHARACTER(len=*), INTENT(in) ::   cd_routine    ! name of the routine 
     223      REAL(wp)        , DIMENSION(jpi,jpj), INTENT(inout) ::   pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft 
     224      !! 
     225      REAL(wp), DIMENSION(jpi,jpj) ::   zdiag_mass, zdiag_salt, zdiag_heat, & 
     226         &                              zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax   
     227      INTEGER ::   jl, jk 
     228      LOGICAL ::   ll_stop_m = .FALSE. 
     229      LOGICAL ::   ll_stop_s = .FALSE. 
     230      LOGICAL ::   ll_stop_t = .FALSE. 
     231      CHARACTER(len=120) ::   clnam   ! filename for the output 
     232      !!------------------------------------------------------------------- 
     233      ! 
     234      IF( icount == 0 ) THEN 
     235 
     236         pdiag_v = SUM( v_i  * rhoi + v_s * rhos, dim=3 ) 
     237         pdiag_s = SUM( sv_i * rhoi             , dim=3 ) 
     238         pdiag_t = SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) 
     239 
     240         ! mass flux 
     241         pdiag_fv = wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd  +  & 
     242            &       wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr 
     243         ! salt flux 
     244         pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam  
     245         ! heat flux 
     246         pdiag_ft =   hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw  &  
     247            &       - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr 
     248 
     249      ELSEIF( icount == 1 ) THEN 
     250 
     251         ! -- mass diag -- ! 
     252         zdiag_mass =   ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_rdtice                             & 
     253            &         + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 
     254            &             wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr )           & 
     255            &         - pdiag_fv 
     256         IF( MAXVAL( ABS(zdiag_mass) ) > zchk_m * rn_icechk_cel )   ll_stop_m = .TRUE. 
     257         ! 
     258         ! -- salt diag -- ! 
     259         zdiag_salt =   ( SUM( sv_i * rhoi , dim=3 ) - pdiag_s ) * r1_rdtice                                                  & 
     260            &         + ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) & 
     261            &         - pdiag_fs 
     262         IF( MAXVAL( ABS(zdiag_salt) ) > zchk_s * rn_icechk_cel )   ll_stop_s = .TRUE. 
     263         ! 
     264         ! -- heat diag -- ! 
     265         zdiag_heat =   ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_rdtice & 
     266            &         + (  hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw                                &  
     267            &            - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr )                                        & 
     268            &         - pdiag_ft 
     269         IF( MAXVAL( ABS(zdiag_heat) ) > zchk_t * rn_icechk_cel )   ll_stop_t = .TRUE. 
     270         ! 
     271         ! -- other diags -- ! 
     272         ! a_i < 0 
     273         zdiag_amin(:,:) = 0._wp 
     274         DO jl = 1, jpl 
     275            WHERE( a_i(:,:,jl) < 0._wp )   zdiag_amin(:,:) = 1._wp 
     276         ENDDO 
     277         ! v_i < 0 
     278         zdiag_vmin(:,:) = 0._wp 
     279         DO jl = 1, jpl 
     280            WHERE( v_i(:,:,jl) < 0._wp )   zdiag_vmin(:,:) = 1._wp 
     281         ENDDO 
     282         ! s_i < 0 
     283         zdiag_smin(:,:) = 0._wp 
     284         DO jl = 1, jpl 
     285            WHERE( s_i(:,:,jl) < 0._wp )   zdiag_smin(:,:) = 1._wp 
     286         ENDDO 
     287         ! e_i < 0 
     288         zdiag_emin(:,:) = 0._wp 
     289         DO jl = 1, jpl 
     290            DO jk = 1, nlay_i 
     291               WHERE( e_i(:,:,jk,jl) < 0._wp )   zdiag_emin(:,:) = 1._wp 
     292            ENDDO 
     293         ENDDO 
     294         ! a_i > amax 
     295         !WHERE( SUM( a_i, dim=3 ) > ( MAX( rn_amax_n, rn_amax_s ) + epsi10 )   ;   zdiag_amax(:,:) = 1._wp 
     296         !ELSEWHERE                                                             ;   zdiag_amax(:,:) = 0._wp 
     297         !END WHERE 
     298 
     299         IF( ll_stop_m .OR. ll_stop_s .OR. ll_stop_t ) THEN 
     300            clnam = 'diag_ice_conservation_'//cd_routine 
     301            CALL ice_cons_wri( clnam, zdiag_mass, zdiag_salt, zdiag_heat, zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin ) 
     302         ENDIF 
     303 
     304         IF( ll_stop_m )   CALL ctl_stop( 'STOP', cd_routine//': ice mass conservation issue' ) 
     305         IF( ll_stop_s )   CALL ctl_stop( 'STOP', cd_routine//': ice salt conservation issue' ) 
     306         IF( ll_stop_t )   CALL ctl_stop( 'STOP', cd_routine//': ice heat conservation issue' ) 
     307          
     308      ENDIF 
     309 
     310   END SUBROUTINE ice_cons2D 
     311 
     312   SUBROUTINE ice_cons_wri( cdfile_name, pdiag_mass, pdiag_salt, pdiag_heat, pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin ) 
     313      !!--------------------------------------------------------------------- 
     314      !!                 ***  ROUTINE ice_cons_wri  *** 
     315      !!         
     316      !! ** Purpose :   create a NetCDF file named cdfile_name which contains  
     317      !!                the instantaneous fields when conservation issue occurs 
     318      !! 
     319      !! ** Method  :   NetCDF files using ioipsl 
     320      !!---------------------------------------------------------------------- 
     321      CHARACTER(len=*), INTENT( in ) ::   cdfile_name      ! name of the file created 
     322      REAL(wp), DIMENSION(:,:), INTENT( in ) ::   pdiag_mass, pdiag_salt, pdiag_heat, & 
     323         &                                        pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax   
     324      !! 
     325      INTEGER ::   inum 
     326      !!---------------------------------------------------------------------- 
     327      !  
     328      IF(lwp) WRITE(numout,*) 
     329      IF(lwp) WRITE(numout,*) 'ice_cons_wri : single instantaneous ice state' 
     330      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~  named :', cdfile_name, '...nc' 
     331      IF(lwp) WRITE(numout,*)                 
     332 
     333      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
     334       
     335      CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 )    ! ice mass spurious lost/gain 
     336      CALL iom_rstput( 0, 0, inum, 'cons_salt', pdiag_salt(:,:) , ktype = jp_r8 )    ! ice salt spurious lost/gain 
     337      CALL iom_rstput( 0, 0, inum, 'cons_heat', pdiag_heat(:,:) , ktype = jp_r8 )    ! ice heat spurious lost/gain 
     338      ! other diags 
     339      CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 )    !  
     340      CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 )    !  
     341      CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 )    !  
     342      CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 )    !  
     343       
     344      CALL iom_close( inum ) 
     345 
     346   END SUBROUTINE ice_cons_wri 
    226347    
    227348   SUBROUTINE ice_ctl( kt ) 
    … …  
    246367      ialert_id = 2 ! reference number of this alert 
    247368      cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert 
    248  
    249369      DO jl = 1, jpl 
    250370         DO jj = 1, jpj 
    251371            DO ji = 1, jpi 
    252372               IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN 
    253                   !WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration ' 
    254                   !WRITE(numout,*) ' at_i     ', at_i(ji,jj) 
    255                   !WRITE(numout,*) ' Point - category', ji, jj, jl 
    256                   !WRITE(numout,*) ' a_i *** a_i_b   ', a_i      (ji,jj,jl), a_i_b  (ji,jj,jl) 
    257                   !WRITE(numout,*) ' v_i *** v_i_b   ', v_i      (ji,jj,jl), v_i_b  (ji,jj,jl) 
     373                  WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration ' 
    258374                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    259375               ENDIF 
    … …  
    269385         DO ji = 1, jpi 
    270386            IF(   h_i(ji,jj,jl)  >  50._wp   ) THEN 
     387               WRITE(numout,*) ' ALERTE 3 :   Very thick ice' 
    271388               !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' ) 
    272389               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    … …  
    280397      DO jj = 1, jpj 
    281398         DO ji = 1, jpi 
    282             IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5  .AND.  & 
     399            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2.  .AND.  & 
    283400               &  at_i(ji,jj) > 0._wp   ) THEN 
     401               WRITE(numout,*) ' ALERTE 4 :   Very fast ice' 
    284402               !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' ) 
    285                !WRITE(numout,*) ' ice strength             : ', strength(ji,jj) 
    286                !WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj)  
    287                !WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj) 
    288                !WRITE(numout,*) ' sea-ice stress utau_ice  : ', utau_ice(ji,jj)  
    289                !WRITE(numout,*) ' sea-ice stress vtau_ice  : ', vtau_ice(ji,jj) 
    290                !WRITE(numout,*) ' sst                      : ', sst_m(ji,jj) 
    291                !WRITE(numout,*) ' sss                      : ', sss_m(ji,jj) 
    292                !WRITE(numout,*)  
     403               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     404            ENDIF 
     405         END DO 
     406      END DO 
     407 
     408      ! Alert on salt flux 
     409      ialert_id = 5 ! reference number of this alert 
     410      cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert 
     411      DO jj = 1, jpj 
     412         DO ji = 1, jpi 
     413            IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth 
     414               WRITE(numout,*) ' ALERTE 5 :   High salt flux' 
     415               !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' ) 
    293416               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    294417            ENDIF 
    … …  
    302425         DO ji = 1, jpi 
    303426            IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN  
     427               WRITE(numout,*) ' ALERTE 6 :   Ice on continents' 
    304428               !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' ) 
    305                !WRITE(numout,*) ' masks s, u, v        : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1)  
    306                !WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
    307                !WRITE(numout,*) ' sss                  : ', sss_m(ji,jj) 
    308                !WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj) 
    309                !WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj) 
    310                !WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1) 
    311                !WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj) 
    312                !WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj) 
    313                ! 
    314429               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    315430            ENDIF 
    … …  
    325440            DO ji = 1, jpi 
    326441               IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     442                  WRITE(numout,*) ' ALERTE 7 :   Very fresh ice' 
    327443!                 CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' ) 
    328 !                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
    329 !                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj) 
    330 !                 WRITE(numout,*)  
    331444                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    332445               ENDIF 
    … …  
    335448      END DO 
    336449! 
     450      ! Alert if qns very big 
     451      ialert_id = 8 ! reference number of this alert 
     452      cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert 
     453      DO jj = 1, jpj 
     454         DO ji = 1, jpi 
     455            IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 
     456               ! 
     457               WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux' 
     458               !CALL ice_prt( kt, ji, jj, 2, '   ') 
     459               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     460               ! 
     461            ENDIF 
     462         END DO 
     463      END DO 
     464      !+++++ 
    337465 
    338466!     ! Alert if too old ice 
    … …  
    345473                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 
    346474                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN 
     475                  WRITE(numout,*) ' ALERTE 9 :   Wrong ice age' 
    347476                  !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ') 
    348477                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    … …  
    351480         END DO 
    352481      END DO 
    353   
    354       ! Alert on salt flux 
    355       ialert_id = 5 ! reference number of this alert 
    356       cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert 
    357       DO jj = 1, jpj 
    358          DO ji = 1, jpi 
    359             IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth 
    360                !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' ) 
    361                !DO jl = 1, jpl 
    362                   !WRITE(numout,*) ' Category no: ', jl 
    363                   !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' a_i_b      : ', a_i_b  (ji,jj,jl)    
    364                   !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' v_i_b      : ', v_i_b  (ji,jj,jl)    
    365                   !WRITE(numout,*) ' ' 
    366                !END DO 
    367                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    368             ENDIF 
    369          END DO 
    370       END DO 
    371  
    372       ! Alert if qns very big 
    373       ialert_id = 8 ! reference number of this alert 
    374       cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert 
    375       DO jj = 1, jpj 
    376          DO ji = 1, jpi 
    377             IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 
    378                ! 
    379                !WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux' 
    380                !WRITE(numout,*) ' ji, jj    : ', ji, jj 
    381                !WRITE(numout,*) ' qns       : ', qns(ji,jj) 
    382                !WRITE(numout,*) ' sst       : ', sst_m(ji,jj) 
    383                !WRITE(numout,*) ' sss       : ', sss_m(ji,jj) 
    384                ! 
    385                !CALL ice_prt( kt, ji, jj, 2, '   ') 
    386                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    387                ! 
    388             ENDIF 
    389          END DO 
    390       END DO 
    391       !+++++ 
    392   
     482   
    393483      ! Alert if very warm ice 
    394484      ialert_id = 10 ! reference number of this alert 
    … …  
    400490               DO ji = 1, jpi 
    401491                  ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
    402                   IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   & 
    403                      &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN 
    404                      !WRITE(numout,*) ' ALERTE 10 :   Very warm ice' 
    405                      !WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 
    406                      !WRITE(numout,*) ' t_i : ', t_i(ji,jj,jk,jl) 
    407                      !WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl) 
    408                      !WRITE(numout,*) ' sz_i: ', sz_i(ji,jj,jk,jl) 
    409                      !WRITE(numout,*) ' ztmelts : ', ztmelts 
    410                      inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     492                  IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   & 
     493                     &                            .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN 
     494                     WRITE(numout,*) ' ALERTE 10 :   Very warm ice' 
     495                    inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    411496                  ENDIF 
    412497               END DO 
    … …  
    435520   END SUBROUTINE ice_ctl 
    436521  
    437     
    438522   SUBROUTINE ice_prt( kt, ki, kj, kn, cd1 ) 
    439523      !!------------------------------------------------------------------- 
    … …  
    443527      !!                in ocean.ouput  
    444528      !!                3 possibilities exist  
    445       !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1) 
     529      !!                n = 1/-1 -> simple ice state 
    446530      !!                n = 2    -> exhaustive state 
    447531      !!                n = 3    -> ice/ocean salt fluxes 
    … …  
    482566               WRITE(numout,*) ' - Cell values ' 
    483567               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    484                WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj) 
    485568               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)        
     569               WRITE(numout,*) ' ato_i         : ', ato_i(ji,jj)        
    486570               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)        
    487571               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)        
    … …  
    503587               END DO 
    504588            ENDIF 
    505             IF( kn == -1 ) THEN 
    506                WRITE(numout,*) ' Mechanical Check ************** ' 
    507                WRITE(numout,*) ' Check what means ice divergence ' 
    508                WRITE(numout,*) ' Total ice concentration ', at_i (ji,jj) 
    509                WRITE(numout,*) ' Total lead fraction     ', ato_i(ji,jj) 
    510                WRITE(numout,*) ' Sum of both             ', ato_i(ji,jj) + at_i(ji,jj) 
    511                WRITE(numout,*) ' Sum of both minus 1     ', ato_i(ji,jj) + at_i(ji,jj) - 1.00 
    512             ENDIF 
    513              
    514589 
    515590            !-------------------- 
    … …  
    525600               WRITE(numout,*) ' - Cell values ' 
    526601               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    527                WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj) 
    528602               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)        
    529603               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)        
    … …  
    624698      !! 
    625699      !!------------------------------------------------------------------- 
    626       CHARACTER(len=*), INTENT(in)  :: cd_routine    ! name of the routine 
    627       INTEGER                       :: jk, jl        ! dummy loop indices 
     700      CHARACTER(len=*), INTENT(in) ::  cd_routine    ! name of the routine 
     701      INTEGER                      ::  jk, jl        ! dummy loop indices 
    628702       
    629703      CALL prt_ctl_info(' ========== ') 
    … …  
    684758       
    685759   END SUBROUTINE ice_prt3D 
    686  
     760       
    687761#else 
    688762   !!---------------------------------------------------------------------- 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icedia.F90

    r10425 r11692  
    3434   PUBLIC   ice_dia_init   ! called in icestp.F90 
    3535 
    36    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents 
     36   REAL(wp), SAVE ::   z1_e1e2  ! inverse of the ocean area 
     37   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   vol_loc_ini, sal_loc_ini, tem_loc_ini                    ! initial volume, salt and heat contents 
    3738   REAL(wp)                              ::   frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot  ! global forcing trends 
    3839    
    … …  
    8081      ENDIF 
    8182 
    82 !!gm glob_sum includes a " * tmask_i ", so remove  " * tmask(:,:,1) " 
    83  
     83      IF( kt == nit000 ) THEN 
     84         z1_e1e2 = 1._wp / glob_sum( 'icedia', e1e2t(:,:) ) 
     85      ENDIF 
     86       
    8487      ! ----------------------- ! 
    85       ! 1 -  Contents ! 
     88      ! 1 -  Contents           ! 
    8689      ! ----------------------- ! 
    87       zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9                  ! ice volume (km3) 
    88       zbg_svol = glob_sum( 'icedia', vt_s(:,:) * e1e2t(:,:) ) * 1.e-9                  ! snow volume (km3) 
    89       zbg_area = glob_sum( 'icedia', at_i(:,:) * e1e2t(:,:) ) * 1.e-6                  ! area (km2) 
    90       zbg_isal = glob_sum( 'icedia', SUM( sv_i(:,:,:), dim=3 ) * e1e2t(:,:) ) * 1.e-9  ! salt content (pss*km3) 
    91       zbg_item = glob_sum( 'icedia', et_i * e1e2t(:,:) ) * 1.e-20                      ! heat content (1.e20 J) 
    92       zbg_stem = glob_sum( 'icedia', et_s * e1e2t(:,:) ) * 1.e-20                      ! heat content (1.e20 J) 
    93        
     90      IF(  iom_use('ibgvol_tot' ) .OR. iom_use('sbgvol_tot' ) .OR. iom_use('ibgarea_tot') .OR. & 
     91         & iom_use('ibgsalt_tot') .OR. iom_use('ibgheat_tot') .OR. iom_use('sbgheat_tot') ) THEN 
     92 
     93         zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9  ! ice volume (km3) 
     94         zbg_svol = glob_sum( 'icedia', vt_s(:,:) * e1e2t(:,:) ) * 1.e-9  ! snow volume (km3) 
     95         zbg_area = glob_sum( 'icedia', at_i(:,:) * e1e2t(:,:) ) * 1.e-6  ! area (km2) 
     96         zbg_isal = glob_sum( 'icedia', st_i(:,:) * e1e2t(:,:) ) * 1.e-9  ! salt content (pss*km3) 
     97         zbg_item = glob_sum( 'icedia', et_i(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 
     98         zbg_stem = glob_sum( 'icedia', et_s(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 
     99 
     100         CALL iom_put( 'ibgvol_tot'  , zbg_ivol )  
     101         CALL iom_put( 'sbgvol_tot'  , zbg_svol )  
     102         CALL iom_put( 'ibgarea_tot' , zbg_area )  
     103         CALL iom_put( 'ibgsalt_tot' , zbg_isal )  
     104         CALL iom_put( 'ibgheat_tot' , zbg_item )  
     105         CALL iom_put( 'sbgheat_tot' , zbg_stem )  
     106  
     107      ENDIF 
     108 
    94109      ! ---------------------------! 
    95110      ! 2 - Trends due to forcing  ! 
    96111      ! ---------------------------! 
     112      ! they must be kept outside an IF(iom_use) because of the call to dia_rst below 
    97113      z_frc_volbot = r1_rau0 * glob_sum( 'icedia', -( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-ocean  
    98114      z_frc_voltop = r1_rau0 * glob_sum( 'icedia', -( wfx_sub(:,:) + wfx_spr(:,:) )                    * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-atm 
    … …  
    106122      frc_temtop  = frc_temtop  + z_frc_temtop  * rdt_ice ! 1.e20 J 
    107123      frc_tembot  = frc_tembot  + z_frc_tembot  * rdt_ice ! 1.e20 J 
     124 
     125      CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water)  
     126      CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water)  
     127      CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)    
     128      CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)    
     129      CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)    
     130 
     131      IF(  iom_use('ibgfrchfxtop') .OR. iom_use('ibgfrchfxbot') ) THEN 
     132         CALL iom_put( 'ibgfrchfxtop' , frc_temtop * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ice/snw/ocean      (W/m2) 
     133         CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ocean(below ice)   (W/m2)  
     134      ENDIF 
     135       
     136      ! ---------------------------------- ! 
     137      ! 3 -  Content variations and drifts ! 
     138      ! ---------------------------------- ! 
     139      IF(  iom_use('ibgvolume') .OR. iom_use('ibgsaltco') .OR. iom_use('ibgheatco') .OR. iom_use('ibgheatfx') ) THEN 
    108140             
    109       ! ----------------------- ! 
    110       ! 3 -  Content variations ! 
    111       ! ----------------------- ! 
    112       zdiff_vol = r1_rau0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3)  
    113       zdiff_sal = r1_rau0 * glob_sum( 'icedia', ( rhoi* SUM( sv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! salt content trend (km3*pss) 
    114       zdiff_tem =           glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:)           - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20  ! heat content trend (1.e20 J) 
    115       !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check) 
    116  
    117       ! ----------------------- ! 
    118       ! 4 -  Drifts             ! 
    119       ! ----------------------- ! 
    120       zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 
    121       zdiff_sal = zdiff_sal - frc_sal 
    122       zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 
    123  
    124       ! ----------------------- ! 
    125       ! 5 - Diagnostics writing ! 
    126       ! ----------------------- ! 
    127 !!gm I don't understand the division by the ocean surface (i.e. glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt ) 
    128 !!   and its multiplication bu kt ! is it really what we want ? what is this quantity ? 
    129 !!   IF it is really what we want, compute it at kt=nit000, not 3 time by time-step ! 
    130 !!   kt*rdt  : you mean rdtice ? 
    131 !!gm 
    132       ! 
    133       IF( iom_use('ibgvolume')    )   CALL iom_put( 'ibgvolume' , zdiff_vol     )   ! ice/snow volume  drift            (km3 equivalent ocean water)          
    134       IF( iom_use('ibgsaltco')    )   CALL iom_put( 'ibgsaltco' , zdiff_sal     )   ! ice salt content drift            (psu*km3 equivalent ocean water) 
    135       IF( iom_use('ibgheatco')    )   CALL iom_put( 'ibgheatco' , zdiff_tem     )   ! ice/snow heat content drift       (1.e20 J) 
    136       IF( iom_use('ibgheatfx')    )   CALL iom_put( 'ibgheatfx' ,               &   ! ice/snow heat flux drift          (W/m2) 
    137          &                                                     zdiff_tem /glob_sum( 'icedia', e1e2t(:,:) * 1.e-20 * kt*rdt ) ) 
    138  
    139       IF( iom_use('ibgfrcvoltop') )   CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water)  
    140       IF( iom_use('ibgfrcvolbot') )   CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water)  
    141       IF( iom_use('ibgfrcsal')    )   CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)    
    142       IF( iom_use('ibgfrctemtop') )   CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)    
    143       IF( iom_use('ibgfrctembot') )   CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)    
    144       IF( iom_use('ibgfrchfxtop') )   CALL iom_put( 'ibgfrchfxtop' ,            &   ! heat on top of ice/snw/ocean      (W/m2)  
    145          &                                                          frc_temtop / glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt  ) 
    146       IF( iom_use('ibgfrchfxbot') )   CALL iom_put( 'ibgfrchfxbot' ,            &   ! heat on top of ocean(below ice)   (W/m2)  
    147          &                                                          frc_tembot / glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt  ) 
    148  
    149       IF( iom_use('ibgvol_tot' )  )   CALL iom_put( 'ibgvol_tot'  , zbg_ivol     )   ! ice volume                       (km3) 
    150       IF( iom_use('sbgvol_tot' )  )   CALL iom_put( 'sbgvol_tot'  , zbg_svol     )   ! snow volume                      (km3) 
    151       IF( iom_use('ibgarea_tot')  )   CALL iom_put( 'ibgarea_tot' , zbg_area     )   ! ice area                         (km2) 
    152       IF( iom_use('ibgsalt_tot')  )   CALL iom_put( 'ibgsalt_tot' , zbg_isal     )   ! ice salinity content             (pss*km3) 
    153       IF( iom_use('ibgheat_tot')  )   CALL iom_put( 'ibgheat_tot' , zbg_item     )   ! ice heat content                 (1.e20 J) 
    154       IF( iom_use('sbgheat_tot')  )   CALL iom_put( 'sbgheat_tot' , zbg_stem     )   ! snow heat content                (1.e20 J) 
    155       ! 
     141         zdiff_vol = r1_rau0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3)  
     142         zdiff_sal = r1_rau0 * glob_sum( 'icedia', ( rhoi*st_i(:,:)                  - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! salt content trend (km3*pss) 
     143         zdiff_tem =           glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:)           - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20  ! heat content trend (1.e20 J) 
     144         !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check) 
     145          
     146         zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 
     147         zdiff_sal = zdiff_sal - frc_sal 
     148         zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 
     149          
     150         CALL iom_put( 'ibgvolume' , zdiff_vol )   ! ice/snow volume  drift            (km3 equivalent ocean water)          
     151         CALL iom_put( 'ibgsaltco' , zdiff_sal )   ! ice salt content drift            (psu*km3 equivalent ocean water) 
     152         CALL iom_put( 'ibgheatco' , zdiff_tem )   ! ice/snow heat content drift       (1.e20 J) 
     153         ! 
     154      ENDIF 
     155       
    156156      IF( lrst_ice )   CALL ice_dia_rst( 'WRITE', kt_ice ) 
    157157      ! 
    … …  
    175175      INTEGER            ::   ios, ierror   ! local integer 
    176176      !! 
    177       NAMELIST/namdia/ ln_icediachk, ln_icediahsb, ln_icectl, iiceprt, jiceprt   
     177      NAMELIST/namdia/ ln_icediachk, rn_icechk_cel, rn_icechk_glo, ln_icediahsb, ln_icectl, iiceprt, jiceprt   
    178178      !!---------------------------------------------------------------------- 
    179179      ! 
    180180      REWIND( numnam_ice_ref )      ! Namelist namdia in reference namelist : Parameters for ice 
    181181      READ  ( numnam_ice_ref, namdia, IOSTAT = ios, ERR = 901) 
    182 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdia in reference namelist', lwp ) 
     182901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdia in reference namelist' ) 
    183183      REWIND( numnam_ice_cfg )      ! Namelist namdia in configuration namelist : Parameters for ice 
    184184      READ  ( numnam_ice_cfg, namdia, IOSTAT = ios, ERR = 902 ) 
    185 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdia in configuration namelist', lwp ) 
     185902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdia in configuration namelist' ) 
    186186      IF(lwm) WRITE ( numoni, namdia ) 
    187187      ! 
    … …  
    191191         WRITE(numout,*) ' ~~~~~~~~~~~' 
    192192         WRITE(numout,*) '   Namelist namdia:' 
    193          WRITE(numout,*) '      Diagnose online heat/mass/salt budget      ln_icediachk = ', ln_icediachk 
    194          WRITE(numout,*) '      Output          heat/mass/salt budget      ln_icediahsb = ', ln_icediahsb 
    195          WRITE(numout,*) '      control prints for a given grid point      ln_icectl    = ', ln_icectl 
    196          WRITE(numout,*) '         chosen grid point position         (iiceprt,jiceprt) = (', iiceprt,',', jiceprt,')' 
     193         WRITE(numout,*) '      Diagnose online heat/mass/salt conservation ln_icediachk  = ', ln_icediachk 
     194         WRITE(numout,*) '         threshold for conservation (gridcell)    rn_icechk_cel = ', rn_icechk_cel 
     195         WRITE(numout,*) '         threshold for conservation (global)      rn_icechk_glo = ', rn_icechk_glo 
     196         WRITE(numout,*) '      Output          heat/mass/salt budget       ln_icediahsb  = ', ln_icediahsb 
     197         WRITE(numout,*) '      control prints for a given grid point       ln_icectl     = ', ln_icectl 
     198         WRITE(numout,*) '         chosen grid point position          (iiceprt,jiceprt)  = (', iiceprt,',', jiceprt,')' 
    197199      ENDIF 
    198200      !       
    … …  
    248250            vol_loc_ini(:,:) = rhoi * vt_i(:,:) + rhos * vt_s(:,:)  ! ice/snow volume (kg/m2) 
    249251            tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:)                ! ice/snow heat content (J) 
    250             sal_loc_ini(:,:) = rhoi * SUM( sv_i(:,:,:), dim=3 )     ! ice salt content (pss*kg/m2) 
     252            sal_loc_ini(:,:) = rhoi * st_i(:,:)                     ! ice salt content (pss*kg/m2) 
    251253         ENDIF 
    252254         ! 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icedyn.F90

    r10994 r11692  
    163163            END DO 
    164164            CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. ) 
    165             CALL iom_put( "icediv" , zdivu_i(:,:) ) 
     165            ! output 
     166            CALL iom_put( 'icediv' , zdivu_i ) 
     167 
    166168            DEALLOCATE( zdivu_i ) 
    167169 
    … …  
    219221      NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice,  & 
    220222         &             rn_ishlat ,                                                           & 
    221          &             ln_landfast_L16, ln_landfast_home, rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile 
     223         &             ln_landfast_L16, rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile 
    222224      !!------------------------------------------------------------------- 
    223225      ! 
    224226      REWIND( numnam_ice_ref )         ! Namelist namdyn in reference namelist : Ice dynamics 
    225227      READ  ( numnam_ice_ref, namdyn, IOSTAT = ios, ERR = 901) 
    226 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn in reference namelist', lwp ) 
     228901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn in reference namelist' ) 
    227229      REWIND( numnam_ice_cfg )         ! Namelist namdyn in configuration namelist : Ice dynamics 
    228230      READ  ( numnam_ice_cfg, namdyn, IOSTAT = ios, ERR = 902 ) 
    229 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn in configuration namelist', lwp ) 
     231902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn in configuration namelist' ) 
    230232      IF(lwm) WRITE( numoni, namdyn ) 
    231233      ! 
    … …  
    242244         WRITE(numout,*) '      lateral boundary condition for sea ice dynamics        rn_ishlat       = ', rn_ishlat 
    243245         WRITE(numout,*) '      Landfast: param from Lemieux 2016                      ln_landfast_L16 = ', ln_landfast_L16 
    244          WRITE(numout,*) '      Landfast: param from home made                         ln_landfast_home= ', ln_landfast_home 
    245246         WRITE(numout,*) '         fraction of ocean depth that ice must reach         rn_depfra       = ', rn_depfra 
    246247         WRITE(numout,*) '         maximum bottom stress per unit area of contact      rn_icebfr       = ', rn_icebfr 
    … …  
    269270      ENDIF 
    270271      !                                      !--- Landfast ice 
    271       IF( .NOT.ln_landfast_L16 .AND. .NOT.ln_landfast_home )   tau_icebfr(:,:) = 0._wp 
    272       ! 
    273       IF ( ln_landfast_L16 .AND. ln_landfast_home ) THEN 
    274          CALL ctl_stop( 'ice_dyn_init: choose one and only one landfast parameterization (ln_landfast_L16 or ln_landfast_home)' ) 
    275       ENDIF 
     272      IF( .NOT.ln_landfast_L16 )   tau_icebfr(:,:) = 0._wp 
    276273      ! 
    277274      CALL ice_dyn_rdgrft_init          ! set ice ridging/rafting parameters 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icedyn_adv.F90

    r10911 r11692  
    100100      diag_trp_vi(:,:) = SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice 
    101101      diag_trp_vs(:,:) = SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice 
    102       IF( iom_use('icemtrp') )   CALL iom_put( "icemtrp" , diag_trp_vi * rhoi          )   ! ice mass transport 
    103       IF( iom_use('snwmtrp') )   CALL iom_put( "snwmtrp" , diag_trp_vs * rhos          )   ! snw mass transport 
    104       IF( iom_use('salmtrp') )   CALL iom_put( "salmtrp" , diag_trp_sv * rhoi * 1.e-03 )   ! salt mass transport (kg/m2/s) 
    105       IF( iom_use('dihctrp') )   CALL iom_put( "dihctrp" , -diag_trp_ei                )   ! advected ice heat content (W/m2) 
    106       IF( iom_use('dshctrp') )   CALL iom_put( "dshctrp" , -diag_trp_es                )   ! advected snw heat content (W/m2) 
     102      IF( iom_use('icemtrp') )   CALL iom_put( 'icemtrp' , diag_trp_vi * rhoi          )   ! ice mass transport 
     103      IF( iom_use('snwmtrp') )   CALL iom_put( 'snwmtrp' , diag_trp_vs * rhos          )   ! snw mass transport 
     104      IF( iom_use('salmtrp') )   CALL iom_put( 'salmtrp' , diag_trp_sv * rhoi * 1.e-03 )   ! salt mass transport (kg/m2/s) 
     105      IF( iom_use('dihctrp') )   CALL iom_put( 'dihctrp' , -diag_trp_ei                 )   ! advected ice heat content (W/m2) 
     106      IF( iom_use('dshctrp') )   CALL iom_put( 'dshctrp' , -diag_trp_es                 )   ! advected snw heat content (W/m2) 
    107107 
    108108      ! controls 
    … …  
    133133      REWIND( numnam_ice_ref )         ! Namelist namdyn_adv in reference namelist : Ice dynamics 
    134134      READ  ( numnam_ice_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 
    135 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp ) 
     135901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist' ) 
    136136      REWIND( numnam_ice_cfg )         ! Namelist namdyn_adv in configuration namelist : Ice dynamics 
    137137      READ  ( numnam_ice_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) 
    138 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp ) 
     138902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist' ) 
    139139      IF(lwm) WRITE( numoni, namdyn_adv ) 
    140140      ! 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icedyn_adv_pra.F90

    r10425 r11692  
    1919   USE ice            ! sea-ice variables 
    2020   USE sbc_oce , ONLY : nn_fsbc   ! frequency of sea-ice call 
     21   USE icevar         ! sea-ice: operations 
    2122   ! 
    2223   USE in_out_manager ! I/O manager 
    … …  
    2526   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
    2627   USE lbclnk         ! lateral boundary conditions (or mpp links) 
    27    USE prtctl         ! Print control 
    2828 
    2929   IMPLICIT NONE 
    … …  
    3636   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxice, syice, sxxice, syyice, sxyice   ! ice thickness  
    3737   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsn , sysn , sxxsn , syysn , sxysn    ! snow thickness 
    38    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxa  , sya  , sxxa  , syya  , sxya     ! lead fraction 
     38   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxa  , sya  , sxxa  , syya  , sxya     ! ice concentration 
    3939   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsal, sysal, sxxsal, syysal, sxysal   ! ice salinity 
    4040   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxage, syage, sxxage, syyage, sxyage   ! ice age 
    41    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sxopw, syopw, sxxopw, syyopw, sxyopw   ! open water in sea ice 
     41   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxopw, syopw, sxxopw, syyopw, sxyopw   ! open water in sea ice 
    4242   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sxc0 , syc0 , sxxc0 , syyc0 , sxyc0    ! snow layers heat content 
    4343   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sxe  , sye  , sxxe  , syye  , sxye     ! ice layers heat content 
    … …  
    8282      ! 
    8383      INTEGER  ::   jk, jl, jt              ! dummy loop indices 
    84       INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    85       REAL(wp) ::   zcfl , zusnit           !   -      - 
    86       REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   zarea 
    87       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   z0opw 
    88       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   z0ice, z0snw, z0ai, z0smi, z0oi 
    89       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   z0ap , z0vp 
    90       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   z0es 
    91       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   z0ei 
     84      INTEGER  ::   icycle                  ! number of sub-timestep for the advection 
     85      REAL(wp) ::   zdt                     !   -      - 
     86      REAL(wp), DIMENSION(1)                  ::   zcflprv, zcflnow   ! for global communication 
     87      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zarea 
     88      REAL(wp), DIMENSION(jpi,jpj,1)          ::   z0opw 
     89      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ice, z0snw, z0ai, z0smi, z0oi 
     90      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ap , z0vp 
     91      REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) ::   z0es 
     92      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) ::   z0ei 
    9293      !!---------------------------------------------------------------------- 
    9394      ! 
    9495      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme' 
    9596      ! 
    96       ALLOCATE( zarea(jpi,jpj)    , z0opw(jpi,jpj, 1 ) , z0ice(jpi,jpj,jpl) , z0snw(jpi,jpj,jpl) ,                       & 
    97          &      z0ai(jpi,jpj,jpl) , z0smi(jpi,jpj,jpl) , z0oi (jpi,jpj,jpl) , z0ap (jpi,jpj,jpl) , z0vp(jpi,jpj,jpl) ,   & 
    98          &      z0es (jpi,jpj,nlay_s,jpl), z0ei(jpi,jpj,nlay_i,jpl) ) 
    99       ! 
    100       ! --- If ice drift field is too fast, use an appropriate time step for advection (CFL test for stability) --- !         
    101       zcfl  =            MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 
    102       zcfl  = MAX( zcfl, MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 
    103       CALL mpp_max( 'icedyn_adv_pra', zcfl ) 
     97      ! --- If ice drift is too fast, use  subtime steps for advection (CFL test for stability) --- ! 
     98      !        Note: the advection split is applied at the next time-step in order to avoid blocking global comm. 
     99      !              this should not affect too much the stability 
     100      zcflnow(1) =                  MAXVAL( ABS( pu_ice(:,:) ) * rdt_ice * r1_e1u(:,:) ) 
     101      zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rdt_ice * r1_e2v(:,:) ) ) 
    104102       
    105       IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp 
    106       ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp 
     103      ! non-blocking global communication send zcflnow and receive zcflprv 
     104      CALL mpp_delay_max( 'icedyn_adv_pra', 'cflice', zcflnow(:), zcflprv(:), kt == nitend - nn_fsbc + 1 ) 
     105 
     106      IF( zcflprv(1) > .5 ) THEN   ;   icycle = 2 
     107      ELSE                         ;   icycle = 1 
    107108      ENDIF 
     109      zdt = rdt_ice / REAL(icycle) 
    108110       
    109       zarea(:,:) = e1e2t(:,:) 
    110111      !------------------------- 
    111112      ! transported fields                                         
    … …  
    113114      z0opw(:,:,1) = pato_i(:,:) * e1e2t(:,:)              ! Open water area  
    114115      DO jl = 1, jpl 
    115          z0snw(:,:,jl) = pv_s (:,:,  jl) * e1e2t(:,:)     ! Snow volume 
    116          z0ice(:,:,jl) = pv_i (:,:,  jl) * e1e2t(:,:)     ! Ice  volume 
    117          z0ai (:,:,jl) = pa_i (:,:,  jl) * e1e2t(:,:)     ! Ice area 
    118          z0smi(:,:,jl) = psv_i(:,:,  jl) * e1e2t(:,:)     ! Salt content 
    119          z0oi (:,:,jl) = poa_i(:,:,  jl) * e1e2t(:,:)     ! Age content 
     116         zarea(:,:,jl) = e1e2t(:,:) 
     117         z0snw(:,:,jl) = pv_s (:,:,jl) * e1e2t(:,:)        ! Snow volume 
     118         z0ice(:,:,jl) = pv_i (:,:,jl) * e1e2t(:,:)        ! Ice  volume 
     119         z0ai (:,:,jl) = pa_i (:,:,jl) * e1e2t(:,:)        ! Ice area 
     120         z0smi(:,:,jl) = psv_i(:,:,jl) * e1e2t(:,:)        ! Salt content 
     121         z0oi (:,:,jl) = poa_i(:,:,jl) * e1e2t(:,:)        ! Age content 
    120122         DO jk = 1, nlay_s 
    121123            z0es(:,:,jk,jl) = pe_s(:,:,jk,jl) * e1e2t(:,:) ! Snow heat content 
    … …  
    133135      IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==! 
    134136         !                                                 !--------------------------------------------! 
    135          DO jt = 1, initad 
    136             CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area 
    137                &                                      sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    138             CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   & 
    139                &                                      sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    140             DO jl = 1, jpl 
    141                CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    142                   &                                      sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    143                CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   & 
    144                   &                                      sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    145                CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    146                   &                                      sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    147                CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   & 
    148                   &                                      sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    149                CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    150                   &                                      sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    151                CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   & 
    152                   &                                      sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    153                CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &    !--- ice age      ---      
    154                   &                                      sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    155                CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   & 
    156                   &                                      sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    157                CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &    !--- ice concentrations --- 
    158                   &                                      sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    159                CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &  
    160                   &                                      sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    161                DO jk = 1, nlay_s                                                               !--- snow heat contents --- 
    162                   CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl),   & 
    163                      &                                      sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) ) 
    164                   CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl),   & 
    165                      &                                      sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) ) 
    166                END DO 
    167                DO jk = 1, nlay_i                                                               !--- ice heat contents --- 
    168                   CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl),   &  
    169                      &                                      sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    170                   CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl),   &  
    171                      &                                      sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    172                END DO 
    173                IF ( ln_pnd_H12 ) THEN 
    174                   CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0ap  (:,:,jl), sxap (:,:,jl),   &    !--- melt pond fraction -- 
    175                      &                                      sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl)  ) 
    176                   CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0ap  (:,:,jl), sxap (:,:,jl),   &  
    177                      &                                      sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl)  ) 
    178                   CALL adv_x( zusnit, pu_ice, 1._wp, zarea, z0vp  (:,:,jl), sxvp (:,:,jl),   &    !--- melt pond volume   -- 
    179                      &                                      sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl)  ) 
    180                   CALL adv_y( zusnit, pv_ice, 0._wp, zarea, z0vp  (:,:,jl), sxvp (:,:,jl),   &  
    181                      &                                      sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl)  ) 
    182                ENDIF 
    183             END DO 
     137         DO jt = 1, icycle 
     138            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw ) !--- open water 
     139            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw ) 
     140            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume 
     141            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) 
     142            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  ) !--- snow volume 
     143            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  ) 
     144            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity 
     145            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) 
     146            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   ) !--- ice concentration 
     147            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   ) 
     148            CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage ) !--- ice age 
     149            CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage ) 
     150            ! 
     151            DO jk = 1, nlay_s                                                                             !--- snow heat content 
     152               CALL adv_x( zdt, pu_ice, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   & 
     153                  &                                   sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 
     154               CALL adv_y( zdt, pv_ice, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   & 
     155                  &                                   sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 
     156            END DO 
     157            DO jk = 1, nlay_i                                                                             !--- ice heat content 
     158               CALL adv_x( zdt, pu_ice, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   &  
     159                  &                                   sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 
     160               CALL adv_y( zdt, pv_ice, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   &  
     161                  &                                   sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 
     162            END DO 
     163            ! 
     164            IF ( ln_pnd_H12 ) THEN 
     165               CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
     166               CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )  
     167               CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
     168               CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )  
     169            ENDIF 
    184170         END DO 
    185171      !                                                    !--------------------------------------------! 
    186172      ELSE                                                 !== even ice time step:  adv_y then adv_x  ==! 
    187173         !                                                 !--------------------------------------------! 
    188          DO jt = 1, initad 
    189             CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0opw (:,:,1), sxopw(:,:),   &             !--- ice open water area 
    190                &                                      sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    191             CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0opw (:,:,1), sxopw(:,:),   & 
    192                &                                      sxxopw(:,:)  , syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    193             DO jl = 1, jpl 
    194                CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    195                   &                                      sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    196                CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ice (:,:,jl), sxice(:,:,jl),   & 
    197                   &                                      sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    198                CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    199                   &                                      sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    200                CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0snw (:,:,jl), sxsn (:,:,jl),   & 
    201                   &                                      sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    202                CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    203                   &                                      sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    204                CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0smi (:,:,jl), sxsal(:,:,jl),   & 
    205                   &                                      sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    206                CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
    207                   &                                      sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    208                CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0oi  (:,:,jl), sxage(:,:,jl),   & 
    209                   &                                      sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    210                CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    211                   &                                      sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    212                CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ai  (:,:,jl), sxa  (:,:,jl),   & 
    213                   &                                      sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    214                DO jk = 1, nlay_s                                                             !--- snow heat contents --- 
    215                   CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl),   & 
    216                      &                                      sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) ) 
    217                   CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0es (:,:,jk,jl), sxc0(:,:,jk,jl),   & 
    218                      &                                      sxxc0(:,:,jk,jl), syc0(:,:,jk,jl), syyc0(:,:,jk,jl), sxyc0(:,:,jk,jl) ) 
    219                END DO 
    220                DO jk = 1, nlay_i                                                             !--- ice heat contents --- 
    221                   CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl),   &  
    222                      &                                      sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    223                   CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ei(:,:,jk,jl), sxe(:,:,jk,jl),   &  
    224                      &                                      sxxe(:,:,jk,jl), sye(:,:,jk,jl), syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    225                END DO 
    226                IF ( ln_pnd_H12 ) THEN 
    227                   CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0ap  (:,:,jl), sxap (:,:,jl),   &   !--- melt pond fraction --- 
    228                      &                                      sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl)  ) 
    229                   CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0ap  (:,:,jl), sxap (:,:,jl),   & 
    230                      &                                      sxxap (:,:,jl), syap (:,:,jl), syyap (:,:,jl), sxyap (:,:,jl)  ) 
    231                   CALL adv_y( zusnit, pv_ice, 1._wp, zarea, z0vp  (:,:,jl), sxvp (:,:,jl),   &   !--- melt pond volume   --- 
    232                      &                                      sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl)  ) 
    233                   CALL adv_x( zusnit, pu_ice, 0._wp, zarea, z0vp  (:,:,jl), sxvp (:,:,jl),   & 
    234                      &                                      sxxvp (:,:,jl), syvp (:,:,jl), syyvp (:,:,jl), sxyvp (:,:,jl)  ) 
    235                ENDIF 
    236             END DO 
     174         DO jt = 1, icycle 
     175            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw ) !--- open water 
     176            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0opw , sxopw , sxxopw , syopw , syyopw , sxyopw ) 
     177            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) !--- ice volume 
     178            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0ice , sxice , sxxice , syice , syyice , sxyice ) 
     179            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  ) !--- snow volume 
     180            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0snw , sxsn  , sxxsn  , sysn  , syysn  , sxysn  ) 
     181            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) !--- ice salinity 
     182            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0smi , sxsal , sxxsal , sysal , syysal , sxysal ) 
     183            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   ) !--- ice concentration 
     184            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0ai  , sxa   , sxxa   , sya   , syya   , sxya   ) 
     185            CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage ) !--- ice age 
     186            CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0oi  , sxage , sxxage , syage , syyage , sxyage ) 
     187            DO jk = 1, nlay_s                                                                             !--- snow heat content 
     188               CALL adv_y( zdt, pv_ice, 1._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   & 
     189                  &                                   sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 
     190               CALL adv_x( zdt, pu_ice, 0._wp, zarea, z0es (:,:,jk,:), sxc0(:,:,jk,:),   & 
     191                  &                                   sxxc0(:,:,jk,:), syc0(:,:,jk,:), syyc0(:,:,jk,:), sxyc0(:,:,jk,:) ) 
     192            END DO 
     193            DO jk = 1, nlay_i                                                                             !--- ice heat content 
     194               CALL adv_y( zdt, pv_ice, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   &  
     195                  &                                   sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 
     196               CALL adv_x( zdt, pu_ice, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:),   &  
     197                  &                                   sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 
     198            END DO 
     199            IF ( ln_pnd_H12 ) THEN 
     200               CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
     201               CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 
     202               CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
     203               CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 
     204            ENDIF 
    237205         END DO 
    238206      ENDIF 
    … …  
    243211      pato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) * tmask(:,:,1) 
    244212      DO jl = 1, jpl 
    245          pv_i (:,:,  jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    246          pv_s (:,:,  jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    247          psv_i(:,:,  jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    248          poa_i(:,:,  jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    249          pa_i (:,:,  jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     213         pv_i (:,:,jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     214         pv_s (:,:,jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     215         psv_i(:,:,jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     216         poa_i(:,:,jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     217         pa_i (:,:,jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    250218         DO jk = 1, nlay_s 
    251219            pe_s(:,:,jk,jl) = z0es(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    … …  
    255223         END DO 
    256224         IF ( ln_pnd_H12 ) THEN 
    257             pa_ip  (:,:,jl) = z0ap (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    258             pv_ip  (:,:,jl) = z0vp (:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     225            pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     226            pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    259227         ENDIF 
    260228      END DO 
    261229      ! 
    262       DEALLOCATE( zarea , z0opw , z0ice, z0snw , z0ai , z0smi , z0oi , z0ap , z0vp , z0es, z0ei ) 
     230      ! --- Ensure non-negative fields --- ! 
     231      !     Remove negative values (conservation is ensured) 
     232      !     (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 
     233      CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     234      ! 
     235      ! --- Ensure snow load is not too big --- ! 
     236      CALL Hsnow( zdt, pv_i, pv_s, pa_i, pa_ip, pe_s ) 
    263237      ! 
    264238      IF( lrst_ice )   CALL adv_pra_rst( 'WRITE', kt )   !* write Prather fields in the restart file 
    … …  
    267241    
    268242    
    269    SUBROUTINE adv_x( pdf, put , pcrh, psm , ps0 ,   & 
     243   SUBROUTINE adv_x( pdt, put , pcrh, psm , ps0 ,   & 
    270244      &              psx, psxx, psy , psyy, psxy ) 
    271245      !!---------------------------------------------------------------------- 
    … …  
    275249      !!                variable on x axis 
    276250      !!---------------------------------------------------------------------- 
    277       REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step 
    278       REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call adv_x then adv_y (=1) or the opposite (=0) 
    279       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   put                ! i-direction ice velocity at U-point [m/s] 
    280       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psm                ! area 
    281       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ps0                ! field to be advected 
    282       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments  
    283       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments 
     251      REAL(wp)                  , INTENT(in   ) ::   pdt                ! the time step 
     252      REAL(wp)                  , INTENT(in   ) ::   pcrh               ! call adv_x then adv_y (=1) or the opposite (=0) 
     253      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   put                ! i-direction ice velocity at U-point [m/s] 
     254      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psm                ! area 
     255      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ps0                ! field to be advected 
     256      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psx , psy          ! 1st moments  
     257      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments 
    284258      !!  
    285       INTEGER  ::   ji, jj                               ! dummy loop indices 
    286       REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! local scalars 
     259      INTEGER  ::   ji, jj, jl, jcat                     ! dummy loop indices 
     260      REAL(wp) ::   zs1max, zslpmax, ztemp               ! local scalars 
    287261      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      - 
    288262      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      - 
    … …  
    291265      REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q         !  -      - 
    292266      !----------------------------------------------------------------------- 
    293  
    294       ! Limitation of moments.                                            
    295  
    296       zrdt = rdt_ice * pdf      ! If ice drift field is too fast, use an appropriate time step for advection. 
    297  
    298       DO jj = 1, jpj 
    299          DO ji = 1, jpi 
    300             zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    301             zs1max  = 1.5 * zslpmax 
    302             zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) ) 
    303             zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    304                &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  ) 
    305             rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    306  
    307             ps0 (ji,jj) = zslpmax   
    308             psx (ji,jj) = zs1new      * rswitch 
    309             psxx(ji,jj) = zs2new      * rswitch 
    310             psy (ji,jj) = psy (ji,jj) * rswitch 
    311             psyy(ji,jj) = psyy(ji,jj) * rswitch 
    312             psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 
    313          END DO 
     267      ! 
     268      jcat = SIZE( ps0 , 3 )   ! size of input arrays 
     269      ! 
     270      DO jl = 1, jcat   ! loop on categories 
     271         ! 
     272         ! Limitation of moments.                                            
     273         DO jj = 2, jpjm1 
     274            DO ji = 1, jpi 
     275               !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
     276               psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 
     277               ! 
     278               zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 
     279               zs1max  = 1.5 * zslpmax 
     280               zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 
     281               zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
     282                  &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) )  ) 
     283               rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
     284 
     285               ps0 (ji,jj,jl) = zslpmax   
     286               psx (ji,jj,jl) = zs1new         * rswitch 
     287               psxx(ji,jj,jl) = zs2new         * rswitch 
     288               psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch 
     289               psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 
     290               psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 
     291            END DO 
     292         END DO 
     293 
     294         !  Calculate fluxes and moments between boxes i<-->i+1               
     295         DO jj = 2, jpjm1                      !  Flux from i to i+1 WHEN u GT 0  
     296            DO ji = 1, jpi 
     297               zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
     298               zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt * e2u(ji,jj) / psm(ji,jj,jl) 
     299               zalfq        =  zalf * zalf 
     300               zalf1        =  1.0 - zalf 
     301               zalf1q       =  zalf1 * zalf1 
     302               ! 
     303               zfm (ji,jj)  =  zalf  *   psm (ji,jj,jl) 
     304               zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) ) 
     305               zfx (ji,jj)  =  zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) ) 
     306               zfxx(ji,jj)  =  zalf  *   psxx(ji,jj,jl) * zalfq 
     307               zfy (ji,jj)  =  zalf  * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 
     308               zfxy(ji,jj)  =  zalfq *   psxy(ji,jj,jl) 
     309               zfyy(ji,jj)  =  zalf  *   psyy(ji,jj,jl) 
     310 
     311               !  Readjust moments remaining in the box. 
     312               psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj) 
     313               ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj) 
     314               psx (ji,jj,jl)  =  zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) ) 
     315               psxx(ji,jj,jl)  =  zalf1  * zalf1q * psxx(ji,jj,jl) 
     316               psy (ji,jj,jl)  =  psy (ji,jj,jl) - zfy(ji,jj) 
     317               psyy(ji,jj,jl)  =  psyy(ji,jj,jl) - zfyy(ji,jj) 
     318               psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl) 
     319            END DO 
     320         END DO 
     321 
     322         DO jj = 2, jpjm1                      !  Flux from i+1 to i when u LT 0. 
     323            DO ji = 1, fs_jpim1 
     324               zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt * e2u(ji,jj) / psm(ji+1,jj,jl)  
     325               zalg  (ji,jj) = zalf 
     326               zalfq         = zalf * zalf 
     327               zalf1         = 1.0 - zalf 
     328               zalg1 (ji,jj) = zalf1 
     329               zalf1q        = zalf1 * zalf1 
     330               zalg1q(ji,jj) = zalf1q 
     331               ! 
     332               zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji+1,jj,jl) 
     333               zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji+1,jj,jl) & 
     334                  &                                   - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) 
     335               zfx   (ji,jj) = zfx (ji,jj) + zalfq * (  psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) 
     336               zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji+1,jj,jl) * zalfq 
     337               zfy   (ji,jj) = zfy (ji,jj) + zalf  * (  psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) 
     338               zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji+1,jj,jl) 
     339               zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji+1,jj,jl) 
     340            END DO 
     341         END DO 
     342 
     343         DO jj = 2, jpjm1                     !  Readjust moments remaining in the box.  
     344            DO ji = fs_2, fs_jpim1 
     345               zbt  =       zbet(ji-1,jj) 
     346               zbt1 = 1.0 - zbet(ji-1,jj) 
     347               ! 
     348               psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 
     349               ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) 
     350               psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) ) 
     351               psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl) 
     352               psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) ) 
     353               psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 
     354               psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 
     355            END DO 
     356         END DO 
     357 
     358         !   Put the temporary moments into appropriate neighboring boxes.     
     359         DO jj = 2, jpjm1                     !   Flux from i to i+1 IF u GT 0. 
     360            DO ji = fs_2, fs_jpim1 
     361               zbt  =       zbet(ji-1,jj) 
     362               zbt1 = 1.0 - zbet(ji-1,jj) 
     363               psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl) 
     364               zalf          = zbt * zfm(ji-1,jj) / psm(ji,jj,jl) 
     365               zalf1         = 1.0 - zalf 
     366               ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj) 
     367               ! 
     368               ps0 (ji,jj,jl) =  zbt  * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl) 
     369               psx (ji,jj,jl) =  zbt  * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl) 
     370               psxx(ji,jj,jl) =  zbt  * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl)                             & 
     371                  &                     + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  ) & 
     372                  &            + zbt1 * psxx(ji,jj,jl) 
     373               psxy(ji,jj,jl) =  zbt  * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl)             & 
     374                  &                     + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj,jl) ) )   & 
     375                  &            + zbt1 * psxy(ji,jj,jl) 
     376               psy (ji,jj,jl) =  zbt  * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 
     377               psyy(ji,jj,jl) =  zbt  * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 
     378            END DO 
     379         END DO 
     380 
     381         DO jj = 2, jpjm1                      !  Flux from i+1 to i IF u LT 0. 
     382            DO ji = fs_2, fs_jpim1 
     383               zbt  =       zbet(ji,jj) 
     384               zbt1 = 1.0 - zbet(ji,jj) 
     385               psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 
     386               zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 
     387               zalf1         = 1.0 - zalf 
     388               ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 
     389               ! 
     390               ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 
     391               psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) 
     392               psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 
     393                  &                                           + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) )    & 
     394                  &                                           + ( zalf1 - zalf ) * ztemp ) ) 
     395               psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  & 
     396                  &                                           + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) ) 
     397               psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) ) 
     398               psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 
     399            END DO 
     400         END DO 
     401 
    314402      END DO 
    315403 
    316       !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
    317       psm (:,:)  = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
    318  
    319       !  Calculate fluxes and moments between boxes i<-->i+1               
    320       DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0  
    321          DO ji = 1, jpi 
    322             zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
    323             zalf         =  MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 
    324             zalfq        =  zalf * zalf 
    325             zalf1        =  1.0 - zalf 
    326             zalf1q       =  zalf1 * zalf1 
    327             ! 
    328             zfm (ji,jj)  =  zalf  *   psm (ji,jj) 
    329             zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj) + zalf1 * ( psx(ji,jj) + (zalf1 - zalf) * psxx(ji,jj) )  ) 
    330             zfx (ji,jj)  =  zalfq * ( psx (ji,jj) + 3.0 * zalf1 * psxx(ji,jj) ) 
    331             zfxx(ji,jj)  =  zalf  *   psxx(ji,jj) * zalfq 
    332             zfy (ji,jj)  =  zalf  * ( psy (ji,jj) + zalf1 * psxy(ji,jj) ) 
    333             zfxy(ji,jj)  =  zalfq *   psxy(ji,jj) 
    334             zfyy(ji,jj)  =  zalf  *   psyy(ji,jj) 
    335  
    336             !  Readjust moments remaining in the box. 
    337             psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj) 
    338             ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj) 
    339             psx (ji,jj)  =  zalf1q * ( psx(ji,jj) - 3.0 * zalf * psxx(ji,jj) ) 
    340             psxx(ji,jj)  =  zalf1  * zalf1q * psxx(ji,jj) 
    341             psy (ji,jj)  =  psy (ji,jj) - zfy(ji,jj) 
    342             psyy(ji,jj)  =  psyy(ji,jj) - zfyy(ji,jj) 
    343             psxy(ji,jj)  =  zalf1q * psxy(ji,jj) 
    344          END DO 
    345       END DO 
    346  
    347       DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0. 
    348          DO ji = 1, fs_jpim1 
    349             zalf          = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
    350             zalg  (ji,jj) = zalf 
    351             zalfq         = zalf * zalf 
    352             zalf1         = 1.0 - zalf 
    353             zalg1 (ji,jj) = zalf1 
    354             zalf1q        = zalf1 * zalf1 
    355             zalg1q(ji,jj) = zalf1q 
    356             ! 
    357             zfm   (ji,jj) = zfm (ji,jj) + zalf  *   psm (ji+1,jj) 
    358             zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0 (ji+1,jj) - zalf1 * ( psx(ji+1,jj) - (zalf1 - zalf ) * psxx(ji+1,jj) ) ) 
    359             zfx   (ji,jj) = zfx (ji,jj) + zalfq * ( psx (ji+1,jj) - 3.0 * zalf1 * psxx(ji+1,jj) ) 
    360             zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *   psxx(ji+1,jj) * zalfq 
    361             zfy   (ji,jj) = zfy (ji,jj) + zalf  * ( psy (ji+1,jj) - zalf1 * psxy(ji+1,jj) ) 
    362             zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *   psxy(ji+1,jj) 
    363             zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *   psyy(ji+1,jj) 
    364          END DO 
    365       END DO 
    366  
    367       DO jj = 2, jpjm1                     !  Readjust moments remaining in the box.  
    368          DO ji = fs_2, fs_jpim1 
    369             zbt  =       zbet(ji-1,jj) 
    370             zbt1 = 1.0 - zbet(ji-1,jj) 
    371             ! 
    372             psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji-1,jj) ) 
    373             ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji-1,jj) ) 
    374             psx (ji,jj) = zalg1q(ji-1,jj) * ( psx(ji,jj) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj) ) 
    375             psxx(ji,jj) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj) 
    376             psy (ji,jj) = zbt * psy (ji,jj) + zbt1 * ( psy (ji,jj) - zfy (ji-1,jj) ) 
    377             psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( psyy(ji,jj) - zfyy(ji-1,jj) ) 
    378             psxy(ji,jj) = zalg1q(ji-1,jj) * psxy(ji,jj) 
    379          END DO 
    380       END DO 
    381  
    382       !   Put the temporary moments into appropriate neighboring boxes.     
    383       DO jj = 2, jpjm1                     !   Flux from i to i+1 IF u GT 0. 
    384          DO ji = fs_2, fs_jpim1 
    385             zbt  =       zbet(ji-1,jj) 
    386             zbt1 = 1.0 - zbet(ji-1,jj) 
    387             psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj) 
    388             zalf        = zbt * zfm(ji-1,jj) / psm(ji,jj) 
    389             zalf1       = 1.0 - zalf 
    390             ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji-1,jj) 
    391             ! 
    392             ps0 (ji,jj) = zbt * ( ps0(ji,jj) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj) 
    393             psx (ji,jj) = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp ) + zbt1 * psx(ji,jj) 
    394             psxx(ji,jj) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj)                               & 
    395                &                + 5.0 * ( zalf * zalf1 * ( psx (ji,jj) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  )   & 
    396                &                                                + zbt1 * psxx(ji,jj) 
    397             psxy(ji,jj) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj)             & 
    398                &                + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj) ) )   & 
    399                &                                                + zbt1 * psxy(ji,jj) 
    400             psy (ji,jj) = zbt * ( psy (ji,jj) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj) 
    401             psyy(ji,jj) = zbt * ( psyy(ji,jj) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj) 
    402          END DO 
    403       END DO 
    404  
    405       DO jj = 2, jpjm1                     !  Flux from i+1 to i IF u LT 0. 
    406          DO ji = fs_2, fs_jpim1 
    407             zbt  =       zbet(ji,jj) 
    408             zbt1 = 1.0 - zbet(ji,jj) 
    409             psm(ji,jj)  = zbt * psm(ji,jj)  + zbt1 * ( psm(ji,jj) + zfm(ji,jj) ) 
    410             zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj) 
    411             zalf1       = 1.0 - zalf 
    412             ztemp       = - zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj) 
    413             ! 
    414             ps0(ji,jj)  = zbt * ps0 (ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) ) 
    415             psx(ji,jj)  = zbt * psx (ji,jj) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp ) 
    416             psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( zalf * zalf * zfxx(ji,jj)  + zalf1 * zalf1 * psxx(ji,jj)  & 
    417                &                                      + 5.0 *( zalf * zalf1 * ( - psx(ji,jj) + zfx(ji,jj) )      & 
    418                &                                      + ( zalf1 - zalf ) * ztemp ) ) 
    419             psxy(ji,jj) = zbt * psxy(ji,jj) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)  & 
    420                &                                      + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj) )  ) 
    421             psy(ji,jj)  = zbt * psy (ji,jj)  + zbt1 * ( psy (ji,jj) + zfy (ji,jj) ) 
    422             psyy(ji,jj) = zbt * psyy(ji,jj)  + zbt1 * ( psyy(ji,jj) + zfyy(ji,jj) ) 
    423          END DO 
    424       END DO 
    425  
    426404      !-- Lateral boundary conditions 
    427       CALL lbc_lnk_multi( 'icedyn_adv_pra', psm , 'T',  1., ps0 , 'T',  1.   & 
    428          &              , psx , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
    429          &              , psxx, 'T',  1., psyy, 'T',  1.   & 
    430          &              , psxy, 'T',  1. ) 
    431  
    432       IF(ln_ctl) THEN 
    433          CALL prt_ctl(tab2d_1=psm  , clinfo1=' adv_x: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ') 
    434          CALL prt_ctl(tab2d_1=psx  , clinfo1=' adv_x: psx  :', tab2d_2=psxx, clinfo2=' psxx : ') 
    435          CALL prt_ctl(tab2d_1=psy  , clinfo1=' adv_x: psy  :', tab2d_2=psyy, clinfo2=' psyy : ') 
    436          CALL prt_ctl(tab2d_1=psxy , clinfo1=' adv_x: psxy :') 
    437       ENDIF 
     405      CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1., ps0 , 'T',  1.   & 
     406         &                                , psx             , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
     407         &                                , psxx            , 'T',  1., psyy, 'T',  1. , psxy, 'T',  1. ) 
    438408      ! 
    439409   END SUBROUTINE adv_x 
    440410 
    441411 
    442    SUBROUTINE adv_y( pdf, pvt , pcrh, psm , ps0 ,   & 
     412   SUBROUTINE adv_y( pdt, pvt , pcrh, psm , ps0 ,   & 
    443413      &              psx, psxx, psy , psyy, psxy ) 
    444414      !!--------------------------------------------------------------------- 
    … …  
    448418      !!                variable on y axis 
    449419      !!--------------------------------------------------------------------- 
    450       REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step 
    451       REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call adv_x then adv_y (=1) or the opposite (=0) 
    452       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvt                ! j-direction ice velocity at V-point [m/s] 
    453       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psm                ! area 
    454       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ps0                ! field to be advected 
    455       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psx , psy          ! 1st moments  
    456       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments 
     420      REAL(wp)                  , INTENT(in   ) ::   pdt                ! time step 
     421      REAL(wp)                  , INTENT(in   ) ::   pcrh               ! call adv_x then adv_y (=1) or the opposite (=0) 
     422      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pvt                ! j-direction ice velocity at V-point [m/s] 
     423      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psm                ! area 
     424      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ps0                ! field to be advected 
     425      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psx , psy          ! 1st moments  
     426      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   psxx, psyy, psxy   ! 2nd moments 
    457427      !! 
    458       INTEGER  ::   ji, jj                               ! dummy loop indices 
    459       REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! temporary scalars 
     428      INTEGER  ::   ji, jj, jl, jcat                     ! dummy loop indices 
     429      REAL(wp) ::   zs1max, zslpmax, ztemp               ! temporary scalars 
    460430      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
    461431      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         - 
    … …  
    464434      REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q     !  -      - 
    465435      !--------------------------------------------------------------------- 
    466  
    467       ! Limitation of moments. 
    468  
    469       zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection. 
    470  
    471       DO jj = 1, jpj 
    472          DO ji = 1, jpi 
    473             zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    474             zs1max  = 1.5 * zslpmax 
    475             zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 
    476             zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    477                &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
    478             rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    479             ! 
    480             ps0 (ji,jj) = zslpmax   
    481             psx (ji,jj) = psx (ji,jj) * rswitch 
    482             psxx(ji,jj) = psxx(ji,jj) * rswitch 
    483             psy (ji,jj) = zs1new * rswitch 
    484             psyy(ji,jj) = zs2new * rswitch 
    485             psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 
    486          END DO 
     436      ! 
     437      jcat = SIZE( ps0 , 3 )   ! size of input arrays 
     438      !       
     439      DO jl = 1, jcat   ! loop on categories 
     440         ! 
     441         ! Limitation of moments. 
     442         DO jj = 1, jpj 
     443            DO ji = fs_2, fs_jpim1 
     444               !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
     445               psm(ji,jj,jl) = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20  ) 
     446               ! 
     447               zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 
     448               zs1max  = 1.5 * zslpmax 
     449               zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 
     450               zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
     451                  &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) )  ) 
     452               rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
     453               ! 
     454               ps0 (ji,jj,jl) = zslpmax   
     455               psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch 
     456               psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch 
     457               psy (ji,jj,jl) = zs1new         * rswitch 
     458               psyy(ji,jj,jl) = zs2new         * rswitch 
     459               psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 
     460            END DO 
     461         END DO 
     462  
     463         !  Calculate fluxes and moments between boxes j<-->j+1               
     464         DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0    
     465            DO ji = fs_2, fs_jpim1 
     466               zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
     467               zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt * e1v(ji,jj) / psm(ji,jj,jl) 
     468               zalfq        =  zalf * zalf 
     469               zalf1        =  1.0 - zalf 
     470               zalf1q       =  zalf1 * zalf1 
     471               ! 
     472               zfm (ji,jj)  =  zalf  * psm(ji,jj,jl) 
     473               zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl)  + (zalf1-zalf) * psyy(ji,jj,jl) ) )  
     474               zfy (ji,jj)  =  zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) ) 
     475               zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj,jl) 
     476               zfx (ji,jj)  =  zalf  * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 
     477               zfxy(ji,jj)  =  zalfq * psxy(ji,jj,jl) 
     478               zfxx(ji,jj)  =  zalf  * psxx(ji,jj,jl) 
     479               ! 
     480               !  Readjust moments remaining in the box. 
     481               psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj) 
     482               ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj) 
     483               psy (ji,jj,jl)  =  zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) ) 
     484               psyy(ji,jj,jl)  =  zalf1 * zalf1q * psyy(ji,jj,jl) 
     485               psx (ji,jj,jl)  =  psx (ji,jj,jl) - zfx(ji,jj) 
     486               psxx(ji,jj,jl)  =  psxx(ji,jj,jl) - zfxx(ji,jj) 
     487               psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl) 
     488            END DO 
     489         END DO 
     490         ! 
     491         DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
     492            DO ji = fs_2, fs_jpim1 
     493               zalf          = ( MAX(0._wp, -pvt(ji,jj) ) * pdt * e1v(ji,jj) ) / psm(ji,jj+1,jl)  
     494               zalg  (ji,jj) = zalf 
     495               zalfq         = zalf * zalf 
     496               zalf1         = 1.0 - zalf 
     497               zalg1 (ji,jj) = zalf1 
     498               zalf1q        = zalf1 * zalf1 
     499               zalg1q(ji,jj) = zalf1q 
     500               ! 
     501               zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji,jj+1,jl) 
     502               zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji,jj+1,jl) & 
     503                  &                                   - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) ) 
     504               zfy   (ji,jj) = zfy (ji,jj) + zalfq * (  psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) ) 
     505               zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji,jj+1,jl) * zalfq 
     506               zfx   (ji,jj) = zfx (ji,jj) + zalf  * (  psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) ) 
     507               zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji,jj+1,jl) 
     508               zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji,jj+1,jl) 
     509            END DO 
     510         END DO 
     511 
     512         !  Readjust moments remaining in the box.  
     513         DO jj = 2, jpjm1 
     514            DO ji = fs_2, fs_jpim1 
     515               zbt  =         zbet(ji,jj-1) 
     516               zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
     517               ! 
     518               psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) ) 
     519               ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) ) 
     520               psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) ) 
     521               psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl) 
     522               psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) ) 
     523               psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 
     524               psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 
     525            END DO 
     526         END DO 
     527 
     528         !   Put the temporary moments into appropriate neighboring boxes.     
     529         DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0. 
     530            DO ji = fs_2, fs_jpim1 
     531               zbt  =       zbet(ji,jj-1) 
     532               zbt1 = 1.0 - zbet(ji,jj-1) 
     533               psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl)  
     534               zalf          = zbt * zfm(ji,jj-1) / psm(ji,jj,jl)  
     535               zalf1         = 1.0 - zalf 
     536               ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1) 
     537               ! 
     538               ps0(ji,jj,jl)  =   zbt  * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl) 
     539               psy(ji,jj,jl)  =   zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )  & 
     540                  &             + zbt1 * psy(ji,jj,jl)   
     541               psyy(ji,jj,jl) =   zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl)                           & 
     542                  &                      + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) &  
     543                  &             + zbt1 * psyy(ji,jj,jl) 
     544               psxy(ji,jj,jl) =   zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl)            & 
     545                  &                      + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) )  & 
     546                  &             + zbt1 * psxy(ji,jj,jl) 
     547               psx (ji,jj,jl) =   zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 
     548               psxx(ji,jj,jl) =   zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 
     549            END DO 
     550         END DO 
     551 
     552         DO jj = 2, jpjm1                      !  Flux from j+1 to j IF v LT 0. 
     553            DO ji = fs_2, fs_jpim1 
     554               zbt  =       zbet(ji,jj) 
     555               zbt1 = 1.0 - zbet(ji,jj) 
     556               psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 
     557               zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 
     558               zalf1         = 1.0 - zalf 
     559               ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 
     560               ! 
     561               ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * (  ps0(ji,jj,jl) + zf0(ji,jj) ) 
     562               psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * (  zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) 
     563               psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) & 
     564                  &                                            + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) )    & 
     565                  &                                            + ( zalf1 - zalf ) * ztemp ) ) 
     566               psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  & 
     567                  &                                            + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) ) 
     568               psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) ) 
     569               psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) ) 
     570            END DO 
     571         END DO 
     572 
    487573      END DO 
    488574 
    489       !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
    490       psm(:,:)  = MAX(  pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) 
    491  
    492       !  Calculate fluxes and moments between boxes j<-->j+1               
    493       DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0    
    494          DO ji = 1, jpi 
    495             zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
    496             zalf         =  MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
    497             zalfq        =  zalf * zalf 
    498             zalf1        =  1.0 - zalf 
    499             zalf1q       =  zalf1 * zalf1 
    500             ! 
    501             zfm (ji,jj)  =  zalf  * psm(ji,jj) 
    502             zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj) + zalf1 * ( psy(ji,jj)  + (zalf1-zalf) * psyy(ji,jj)  ) )  
    503             zfy (ji,jj)  =  zalfq *( psy(ji,jj) + 3.0*zalf1*psyy(ji,jj) ) 
    504             zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj) 
    505             zfx (ji,jj)  =  zalf  * ( psx(ji,jj) + zalf1 * psxy(ji,jj) ) 
    506             zfxy(ji,jj)  =  zalfq * psxy(ji,jj) 
    507             zfxx(ji,jj)  =  zalf  * psxx(ji,jj) 
    508             ! 
    509             !  Readjust moments remaining in the box. 
    510             psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj) 
    511             ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj) 
    512             psy (ji,jj)  =  zalf1q * ( psy(ji,jj) -3.0 * zalf * psyy(ji,jj) ) 
    513             psyy(ji,jj)  =  zalf1 * zalf1q * psyy(ji,jj) 
    514             psx (ji,jj)  =  psx (ji,jj) - zfx(ji,jj) 
    515             psxx(ji,jj)  =  psxx(ji,jj) - zfxx(ji,jj) 
    516             psxy(ji,jj)  =  zalf1q * psxy(ji,jj) 
     575      !-- Lateral boundary conditions 
     576      CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1., ps0 , 'T',  1.   & 
     577         &                                , psx             , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
     578         &                                , psxx            , 'T',  1., psyy, 'T',  1. , psxy, 'T',  1. ) 
     579      ! 
     580   END SUBROUTINE adv_y 
     581 
     582 
     583   SUBROUTINE Hsnow( pdt, pv_i, pv_s, pa_i, pa_ip, pe_s ) 
     584      !!------------------------------------------------------------------- 
     585      !!                  ***  ROUTINE Hsnow  *** 
     586      !! 
     587      !! ** Purpose : 1- Check snow load after advection 
     588      !!              2- Correct pond concentration to avoid a_ip > a_i 
     589      !! 
     590      !! ** Method :  If snow load makes snow-ice interface to deplet below the ocean surface 
     591      !!              then put the snow excess in the ocean 
     592      !! 
     593      !! ** Notes :   This correction is crucial because of the call to routine icecor afterwards 
     594      !!              which imposes a mini of ice thick. (rn_himin). This imposed mini can artificially 
     595      !!              make the snow very thick (if concentration decreases drastically) 
     596      !!              This behavior has been seen in Ultimate-Macho and supposedly it can also be true for Prather 
     597      !!------------------------------------------------------------------- 
     598      REAL(wp)                    , INTENT(in   ) ::   pdt   ! tracer time-step 
     599      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip 
     600      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s 
     601      ! 
     602      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
     603      REAL(wp) ::   z1_dt, zvs_excess, zfra 
     604      !!------------------------------------------------------------------- 
     605      ! 
     606      z1_dt = 1._wp / pdt 
     607      ! 
     608      ! -- check snow load -- ! 
     609      DO jl = 1, jpl 
     610         DO jj = 1, jpj 
     611            DO ji = 1, jpi 
     612               IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     613                  ! 
     614                  zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 
     615                  ! 
     616                  IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface 
     617                     ! put snow excess in the ocean 
     618                     zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 
     619                     wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 
     620                     hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     621                     ! correct snow volume and heat content 
     622                     pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 
     623                     pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess 
     624                  ENDIF 
     625                  ! 
     626               ENDIF 
     627            END DO 
    517628         END DO 
    518629      END DO 
    519630      ! 
    520       DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
    521          DO ji = 1, jpi 
    522             zalf          = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
    523             zalg  (ji,jj) = zalf 
    524             zalfq         = zalf * zalf 
    525             zalf1         = 1.0 - zalf 
    526             zalg1 (ji,jj) = zalf1 
    527             zalf1q        = zalf1 * zalf1 
    528             zalg1q(ji,jj) = zalf1q 
    529             ! 
    530             zfm   (ji,jj) = zfm (ji,jj) + zalf  *   psm (ji,jj+1) 
    531             zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0 (ji,jj+1) - zalf1 * (psy(ji,jj+1) - (zalf1 - zalf ) * psyy(ji,jj+1) ) ) 
    532             zfy   (ji,jj) = zfy (ji,jj) + zalfq * ( psy (ji,jj+1) - 3.0 * zalf1 * psyy(ji,jj+1) ) 
    533             zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *   psyy(ji,jj+1) * zalfq 
    534             zfx   (ji,jj) = zfx (ji,jj) + zalf  * ( psx (ji,jj+1) - zalf1 * psxy(ji,jj+1) ) 
    535             zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *   psxy(ji,jj+1) 
    536             zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *   psxx(ji,jj+1) 
    537          END DO 
    538       END DO 
    539  
    540       !  Readjust moments remaining in the box.  
    541       DO jj = 2, jpj 
    542          DO ji = 1, jpi 
    543             zbt  =         zbet(ji,jj-1) 
    544             zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
    545             ! 
    546             psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji,jj-1) ) 
    547             ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji,jj-1) ) 
    548             psy (ji,jj) = zalg1q(ji,jj-1) * ( psy(ji,jj) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj) ) 
    549             psyy(ji,jj) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj) 
    550             psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) - zfx (ji,jj-1) ) 
    551             psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) - zfxx(ji,jj-1) ) 
    552             psxy(ji,jj) = zalg1q(ji,jj-1) * psxy(ji,jj) 
    553          END DO 
    554       END DO 
    555  
    556       !   Put the temporary moments into appropriate neighboring boxes.     
    557       DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0. 
    558          DO ji = 1, jpi 
    559             zbt  =         zbet(ji,jj-1) 
    560             zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
    561             psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj)  
    562             zalf        = zbt * zfm(ji,jj-1) / psm(ji,jj)  
    563             zalf1       = 1.0 - zalf 
    564             ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji,jj-1) 
    565             ! 
    566             ps0(ji,jj)  = zbt  * ( ps0(ji,jj) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj) 
    567             psy(ji,jj)  = zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj) + 3.0 * ztemp )   & 
    568                &                                               + zbt1 * psy(ji,jj)   
    569             psyy(ji,jj) = zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj)                             & 
    570                &                 + 5.0 * ( zalf * zalf1 * ( psy(ji,jj) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) )   &  
    571                &                                               + zbt1 * psyy(ji,jj) 
    572             psxy(ji,jj) = zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj)               & 
    573                &                  + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj) )  )   & 
    574                &                                                + zbt1 * psxy(ji,jj) 
    575             psx (ji,jj) = zbt * ( psx (ji,jj) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj) 
    576             psxx(ji,jj) = zbt * ( psxx(ji,jj) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj) 
    577          END DO 
    578       END DO 
    579  
    580       DO jj = 2, jpjm1                   !  Flux from j+1 to j IF v LT 0. 
    581          DO ji = 1, jpi 
    582             zbt  =         zbet(ji,jj) 
    583             zbt1 = ( 1.0 - zbet(ji,jj) ) 
    584             psm(ji,jj)  = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) ) 
    585             zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj) 
    586             zalf1       = 1.0 - zalf 
    587             ztemp       = - zalf * ps0 (ji,jj) + zalf1 * zf0(ji,jj) 
    588             ps0 (ji,jj) =   zbt  * ps0 (ji,jj) + zbt1  * ( ps0(ji,jj) + zf0(ji,jj) ) 
    589             psy (ji,jj) =   zbt  * psy (ji,jj) + zbt1  * ( zalf * zfy(ji,jj) + zalf1 * psy(ji,jj) + 3.0 * ztemp ) 
    590             psyy(ji,jj) =   zbt  * psyy(ji,jj) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj)   & 
    591                &                                         + 5.0 *( zalf *zalf1 *( -psy(ji,jj) + zfy(ji,jj) )          & 
    592                &                                         + ( zalf1 - zalf ) * ztemp )                                ) 
    593             psxy(ji,jj) =   zbt  * psxy(ji,jj) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)       & 
    594                &                                         + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj) )  ) 
    595             psx (ji,jj) =   zbt  * psx (ji,jj) + zbt1 * ( psx (ji,jj) + zfx (ji,jj) ) 
    596             psxx(ji,jj) =   zbt  * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) + zfxx(ji,jj) ) 
    597          END DO 
    598       END DO 
    599  
    600       !-- Lateral boundary conditions 
    601       CALL lbc_lnk_multi( 'icedyn_adv_pra', psm , 'T',  1.,  ps0 , 'T',  1.   & 
    602          &              , psx , 'T', -1.,  psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
    603          &              , psxx, 'T',  1.,  psyy, 'T',  1.   & 
    604          &              , psxy, 'T',  1. ) 
    605  
    606       IF(ln_ctl) THEN 
    607          CALL prt_ctl(tab2d_1=psm  , clinfo1=' adv_y: psm  :', tab2d_2=ps0 , clinfo2=' ps0  : ') 
    608          CALL prt_ctl(tab2d_1=psx  , clinfo1=' adv_y: psx  :', tab2d_2=psxx, clinfo2=' psxx : ') 
    609          CALL prt_ctl(tab2d_1=psy  , clinfo1=' adv_y: psy  :', tab2d_2=psyy, clinfo2=' psyy : ') 
    610          CALL prt_ctl(tab2d_1=psxy , clinfo1=' adv_y: psxy :') 
    611       ENDIF 
    612       ! 
    613    END SUBROUTINE adv_y 
     631      !-- correct pond concentration to avoid a_ip > a_i -- ! 
     632      WHERE( pa_ip(:,:,:) > pa_i(:,:,:) )   pa_ip(:,:,:) = pa_i(:,:,:) 
     633      ! 
     634   END SUBROUTINE Hsnow 
    614635 
    615636 
    … …  
    624645      ! 
    625646      !                             !* allocate prather fields 
    626       ALLOCATE( sxopw(jpi,jpj)     , syopw(jpi,jpj)     , sxxopw(jpi,jpj)     , syyopw(jpi,jpj)     , sxyopw(jpi,jpj)     ,   & 
     647      ALLOCATE( sxopw(jpi,jpj,1)   , syopw(jpi,jpj,1)   , sxxopw(jpi,jpj,1)   , syyopw(jpi,jpj,1)   , sxyopw(jpi,jpj,1)   ,   & 
    627648         &      sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) ,   & 
    628649         &      sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) ,   & 
    … …  
    652673      !!                   ***  ROUTINE adv_pra_rst  *** 
    653674      !!                      
    654       !! ** Purpose :   Read or write RHG file in restart file 
     675      !! ** Purpose :   Read or write file in restart file 
    655676      !! 
    656677      !! ** Method  :   use of IOM library 
    … …  
    689710            CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn  ) 
    690711            CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn  ) 
    691             !                                                        ! lead fraction 
     712            !                                                        ! ice concentration 
    692713            CALL iom_get( numrir, jpdom_autoglo, 'sxa'   , sxa    ) 
    693714            CALL iom_get( numrir, jpdom_autoglo, 'sya'   , sya    ) 
    … …  
    752773            sxice = 0._wp   ;   syice = 0._wp   ;   sxxice = 0._wp   ;   syyice = 0._wp   ;   sxyice = 0._wp      ! ice thickness 
    753774            sxsn  = 0._wp   ;   sysn  = 0._wp   ;   sxxsn  = 0._wp   ;   syysn  = 0._wp   ;   sxysn  = 0._wp      ! snow thickness 
    754             sxa   = 0._wp   ;   sya   = 0._wp   ;   sxxa   = 0._wp   ;   syya   = 0._wp   ;   sxya   = 0._wp      ! lead fraction 
     775            sxa   = 0._wp   ;   sya   = 0._wp   ;   sxxa   = 0._wp   ;   syya   = 0._wp   ;   sxya   = 0._wp      ! ice concentration 
    755776            sxsal = 0._wp   ;   sysal = 0._wp   ;   sxxsal = 0._wp   ;   syysal = 0._wp   ;   sxysal = 0._wp      ! ice salinity 
    756777            sxage = 0._wp   ;   syage = 0._wp   ;   sxxage = 0._wp   ;   syyage = 0._wp   ;   sxyage = 0._wp      ! ice age 
    … …  
    786807         CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn  ) 
    787808         CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn  ) 
    788          !                                                           ! lead fraction 
     809         !                                                           ! ice concentration 
    789810         CALL iom_rstput( iter, nitrst, numriw, 'sxa'   , sxa    ) 
    790811         CALL iom_rstput( iter, nitrst, numriw, 'sya'   , sya    ) 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icedyn_adv_umx.F90

    r10945 r11692  
    8383      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   poa_i      ! age content 
    8484      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_i       ! ice concentration 
    85       REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
     85      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond concentration 
    8686      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
    8787      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    … …  
    319319         ! 
    320320         !== Ice age ==! 
    321          IF( iom_use('iceage') .OR. iom_use('iceage_cat') ) THEN 
    322             zamsk = 1._wp 
    323             CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 
    324                &                                      poa_i, poa_i ) 
    325          ENDIF 
     321         zamsk = 1._wp 
     322         CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 
     323            &                                      poa_i, poa_i ) 
    326324         ! 
    327325         !== melt ponds ==! 
    328326         IF ( ln_pnd_H12 ) THEN 
    329             ! fraction 
     327            ! concentration 
    330328            zamsk = 1._wp 
    331329            CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat , zv_cat , zcu_box, zcv_box, & 
    … …  
    15291527      !!              3- check whether snow load deplets the snow-ice interface below sea level$ 
    15301528      !!                 and reduce it by sending the excess in the ocean 
    1531       !!              4- correct pond fraction to avoid a_ip > a_i 
     1529      !!              4- correct pond concentration to avoid a_ip > a_i 
    15321530      !! 
    15331531      !! ** input   : Max thickness of the surrounding 9-points 
    … …  
    15991597         END DO 
    16001598      END DO  
    1601       !                                           !-- correct pond fraction to avoid a_ip > a_i 
     1599      !                                           !-- correct pond concentration to avoid a_ip > a_i 
    16021600      WHERE( pa_ip(:,:,:) > pa_i(:,:,:) )   pa_ip(:,:,:) = pa_i(:,:,:) 
    16031601      ! 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icedyn_rdgrft.F90

    r10994 r11692  
    145145      IF( ln_timing    )   CALL timing_start('icedyn_rdgrft')                                                             ! timing 
    146146      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
     147      IF( ln_icediachk )   CALL ice_cons2D  (0, 'icedyn_rdgrft',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    147148 
    148149      IF( kt == nit000 ) THEN 
    … …  
    276277 
    277278      ! controls 
     279      IF( ln_ctl       )   CALL ice_prt3D   ('icedyn_rdgrft')                                                             ! prints 
     280      IF( ln_icectl    )   CALL ice_prt     (kt, iiceprt, jiceprt,-1, ' - ice dyn rdgrft - ')                             ! prints 
    278281      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
    279       IF( ln_ctl       )   CALL ice_prt3D   ('icedyn_rdgrft')                                                             ! prints 
     282      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icedyn_rdgrft',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    280283      IF( ln_timing    )   CALL timing_stop ('icedyn_rdgrft')                                                             ! timing 
    281284      ! 
    … …  
    916919      REWIND( numnam_ice_ref )              ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 
    917920      READ  ( numnam_ice_ref, namdyn_rdgrft, IOSTAT = ios, ERR = 901) 
    918 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist', lwp ) 
     921901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist' ) 
    919922      REWIND( numnam_ice_cfg )              ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution 
    920923      READ  ( numnam_ice_cfg, namdyn_rdgrft, IOSTAT = ios, ERR = 902 ) 
    921 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist', lwp ) 
     924902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist' ) 
    922925      IF(lwm) WRITE ( numoni, namdyn_rdgrft ) 
    923926      ! 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icedyn_rhg.F90

    r10911 r11692  
    6464      IF( ln_timing    )   CALL timing_start('icedyn_rhg')                                                             ! timing 
    6565      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icedyn_rhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
     66      IF( ln_icediachk )   CALL ice_cons2D  (0, 'icedyn_rhg',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    6667      ! 
    6768      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    6970         WRITE(numout,*)'ice_dyn_rhg: sea-ice rheology' 
    7071         WRITE(numout,*)'~~~~~~~~~~~' 
    71       ENDIF 
    72       ! 
    73       IF( ln_landfast_home ) THEN      !-- Landfast ice parameterization 
    74          tau_icebfr(:,:) = 0._wp 
    75          DO jl = 1, jpl 
    76             WHERE( h_i(:,:,jl) > ht_n(:,:) * rn_depfra )   tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 
    77          END DO 
    7872      ENDIF 
    7973      ! 
    … …  
    9488      ! 
    9589      ! controls 
     90      IF( ln_ctl       )   CALL ice_prt3D   ('icedyn_rhg')                                                             ! prints 
    9691      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icedyn_rhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
    97       IF( ln_ctl       )   CALL ice_prt3D   ('icedyn_rhg')                                                             ! prints 
     92      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icedyn_rhg',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    9893      IF( ln_timing    )   CALL timing_stop ('icedyn_rhg')                                                             ! timing 
    9994      ! 
    … …  
    120115      REWIND( numnam_ice_ref )         ! Namelist namdyn_rhg in reference namelist : Ice dynamics 
    121116      READ  ( numnam_ice_ref, namdyn_rhg, IOSTAT = ios, ERR = 901) 
    122 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist', lwp ) 
     117901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist' ) 
    123118      REWIND( numnam_ice_cfg )         ! Namelist namdyn_rhg in configuration namelist : Ice dynamics 
    124119      READ  ( numnam_ice_cfg, namdyn_rhg, IOSTAT = ios, ERR = 902 ) 
    125 902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namdyn_rhg in configuration namelist', lwp ) 
     120902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namdyn_rhg in configuration namelist' ) 
    126121      IF(lwm) WRITE ( numoni, namdyn_rhg ) 
    127122      ! 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icedyn_rhg_evp.F90

    r10891 r11692  
    112112      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pshear_i  , pdivu_i   , pdelta_i      ! 
    113113      !! 
    114       LOGICAL, PARAMETER ::   ll_bdy_substep = .TRUE. ! temporary option to call bdy at each sub-time step (T) 
    115       !                                                                              or only at the main time step (F) 
    116114      INTEGER ::   ji, jj       ! dummy loop indices 
    117115      INTEGER ::   jter         ! local integers 
    … …  
    123121      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV, zvU, zvV             ! ice/snow mass and volume 
    124122      REAL(wp) ::   zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2       ! temporary scalars 
    125       REAL(wp) ::   zTauO, zTauB, zTauE, zvel                           ! temporary scalars 
     123      REAL(wp) ::   zTauO, zTauB, zRHS, zvel                            ! temporary scalars 
    126124      REAL(wp) ::   zkt                                                 ! isotropic tensile strength for landfast ice 
    127125      REAL(wp) ::   zvCr                                                ! critical ice volume above which ice is landfast 
    … …  
    132130      REAL(wp) ::   zshear, zdum1, zdum2 
    133131      ! 
    134       REAL(wp), DIMENSION(jpi,jpj) ::   z1_e1t0, z1_e2t0                ! scale factors 
    135132      REAL(wp), DIMENSION(jpi,jpj) ::   zp_delt                         ! P/delta at T points 
    136133      REAL(wp), DIMENSION(jpi,jpj) ::   zbeta                           ! beta coef from Kimmritz 2017 
    137134      ! 
    138135      REAL(wp), DIMENSION(jpi,jpj) ::   zdt_m                           ! (dt / ice-snow_mass) on T points 
    139       REAL(wp), DIMENSION(jpi,jpj) ::   zaU   , zaV                     ! ice fraction on U/V points 
     136      REAL(wp), DIMENSION(jpi,jpj) ::   zaU  , zaV                      ! ice fraction on U/V points 
    140137      REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! (ice-snow_mass / dt) on U/V points 
    141138      REAL(wp), DIMENSION(jpi,jpj) ::   zmf                             ! coriolis parameter at T points 
    142       REAL(wp), DIMENSION(jpi,jpj) ::   zTauU_ia , ztauV_ia             ! ice-atm. stress at U-V points 
    143       REAL(wp), DIMENSION(jpi,jpj) ::   zTauU_ib , ztauV_ib             ! ice-bottom stress at U-V points (landfast param) 
    144       REAL(wp), DIMENSION(jpi,jpj) ::   zspgU , zspgV                   ! surface pressure gradient at U/V points 
    145139      REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points                            
    146       REAL(wp), DIMENSION(jpi,jpj) ::   zfU   , zfV                     ! internal stresses 
    147140      ! 
    148141      REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear 
    … …  
    152145      !                                                                 !    ocean surface (ssh_m) if ice is not embedded 
    153146      !                                                                 !    ice bottom surface if ice is embedded    
    154       REAL(wp), DIMENSION(jpi,jpj) ::   zCorx, zCory                    ! Coriolis stress array 
    155       REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_oi, ztauy_oi              ! Ocean-to-ice stress array 
    156       ! 
    157       REAL(wp), DIMENSION(jpi,jpj) ::   zswitchU, zswitchV              ! dummy arrays 
    158       REAL(wp), DIMENSION(jpi,jpj) ::   zmaskU, zmaskV                  ! mask for ice presence 
     147      REAL(wp), DIMENSION(jpi,jpj) ::   zfU  , zfV                      ! internal stresses 
     148      REAL(wp), DIMENSION(jpi,jpj) ::   zspgU, zspgV                    ! surface pressure gradient at U/V points 
     149      REAL(wp), DIMENSION(jpi,jpj) ::   zCorU, zCorV                    ! Coriolis stress array 
     150      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_ai, ztauy_ai              ! ice-atm. stress at U-V points 
     151      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_oi, ztauy_oi              ! ice-ocean stress at U-V points 
     152      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_bi, ztauy_bi              ! ice-OceanBottom stress at U-V points (landfast) 
     153      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast) 
     154      ! 
     155      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays 
     156      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence 
    159157      REAL(wp), DIMENSION(jpi,jpj) ::   zfmask, zwf                     ! mask at F points for the ice 
    160158 
    … …  
    163161      REAL(wp), PARAMETER          ::   zamin  = 0.001_wp               ! ice concentration below which ice velocity becomes very small 
    164162      !! --- diags 
    165       REAL(wp), DIMENSION(jpi,jpj) ::   zswi 
     163      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00 
    166164      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig1, zsig2, zsig3 
    167165      !! --- SIMIP diags 
    168       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_sig1      ! Average normal stress in sea ice    
    169       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_sig2      ! Maximum shear stress in sea ice 
    170       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_dssh_dx   ! X-direction sea-surface tilt term (N/m2) 
    171       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_dssh_dy   ! X-direction sea-surface tilt term (N/m2) 
    172       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_corstrx   ! X-direction coriolis stress (N/m2) 
    173       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_corstry   ! Y-direction coriolis stress (N/m2) 
    174       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_intstrx   ! X-direction internal stress (N/m2) 
    175       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_intstry   ! Y-direction internal stress (N/m2) 
    176       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_utau_oi   ! X-direction ocean-ice stress 
    177       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_vtau_oi   ! Y-direction ocean-ice stress   
    178166      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xmtrp_ice ! X-component of ice mass transport (kg/s) 
    179167      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_ymtrp_ice ! Y-component of ice mass transport (kg/s) 
    … …  
    255243      CALL ice_strength 
    256244 
    257       ! scale factors 
    258       DO jj = 2, jpjm1 
    259          DO ji = fs_2, fs_jpim1 
    260             z1_e1t0(ji,jj) = 1._wp / ( e1t(ji+1,jj  ) + e1t(ji,jj  ) ) 
    261             z1_e2t0(ji,jj) = 1._wp / ( e2t(ji  ,jj+1) + e2t(ji,jj  ) ) 
    262          END DO 
    263       END DO 
    264  
    265245      ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010) 
    266       IF( ln_landfast_L16 .OR. ln_landfast_home ) THEN   ;   zkt = rn_tensile 
    267       ELSE                                               ;   zkt = 0._wp 
     246      IF( ln_landfast_L16 ) THEN   ;   zkt = rn_tensile 
     247      ELSE                         ;   zkt = 0._wp 
    268248      ENDIF 
    269249      ! 
    … …  
    291271 
    292272            ! Ocean currents at U-V points 
    293             v_oceU(ji,jj)   = 0.5_wp * ( ( v_oce(ji  ,jj) + v_oce(ji  ,jj-1) ) * e1t(ji+1,jj)    & 
    294                &                       + ( v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * e1t(ji  ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 
    295              
    296             u_oceV(ji,jj)   = 0.5_wp * ( ( u_oce(ji,jj  ) + u_oce(ji-1,jj  ) ) * e2t(ji,jj+1)    & 
    297                &                       + ( u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * e2t(ji,jj  ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 
     273            v_oceU(ji,jj)   = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 
     274            u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 
    298275 
    299276            ! Coriolis at T points (m*f) 
    … …  
    308285             
    309286            ! Drag ice-atm. 
    310             zTauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 
    311             zTauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 
     287            ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 
     288            ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 
    312289 
    313290            ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 
    … …  
    316293 
    317294            ! masks 
    318             zmaskU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice 
    319             zmaskV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice 
     295            zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice 
     296            zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice 
    320297 
    321298            ! switches 
    322             IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zswitchU(ji,jj) = 0._wp 
    323             ELSE                                                   ;   zswitchU(ji,jj) = 1._wp   ;   ENDIF 
    324             IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zswitchV(ji,jj) = 0._wp 
    325             ELSE                                                   ;   zswitchV(ji,jj) = 1._wp   ;   ENDIF 
     299            IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp 
     300            ELSE                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF 
     301            IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp 
     302            ELSE                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF 
    326303 
    327304         END DO 
    … …  
    339316               ! ice-bottom stress at U points 
    340317               zvCr = zaU(ji,jj) * rn_depfra * hu_n(ji,jj) 
    341                zTauU_ib(ji,jj)   = rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
     318               ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
    342319               ! ice-bottom stress at V points 
    343320               zvCr = zaV(ji,jj) * rn_depfra * hv_n(ji,jj) 
    344                zTauV_ib(ji,jj)   = rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
     321               ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
    345322               ! ice_bottom stress at T points 
    346323               zvCr = at_i(ji,jj) * rn_depfra * ht_n(ji,jj) 
    347                tau_icebfr(ji,jj) = rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
     324               tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
    348325            END DO 
    349326         END DO 
    350327         CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. ) 
    351328         ! 
    352       ELSEIF( ln_landfast_home ) THEN          !-- Home made 
     329      ELSE                               !-- no landfast 
    353330         DO jj = 2, jpjm1 
    354331            DO ji = fs_2, fs_jpim1 
    355                zTauU_ib(ji,jj) = tau_icebfr(ji,jj) 
    356                zTauV_ib(ji,jj) = tau_icebfr(ji,jj) 
    357             END DO 
    358          END DO 
    359          ! 
    360       ELSE                                     !-- no landfast 
    361          DO jj = 2, jpjm1 
    362             DO ji = fs_2, fs_jpim1 
    363                zTauU_ib(ji,jj) = 0._wp 
    364                zTauV_ib(ji,jj) = 0._wp 
     332               ztaux_base(ji,jj) = 0._wp 
     333               ztauy_base(ji,jj) = 0._wp 
    365334            END DO 
    366335         END DO 
    367336      ENDIF 
    368       IF( iom_use('tau_icebfr') )   CALL iom_put( 'tau_icebfr', tau_icebfr(:,:) ) 
    369337 
    370338      !------------------------------------------------------------------------------! 
    … …  
    372340      !------------------------------------------------------------------------------! 
    373341      ! 
    374       !                                               !----------------------! 
     342      !                                               ! ==================== ! 
    375343      DO jter = 1 , nn_nevp                           !    loop over jter    ! 
    376          !                                            !----------------------!         
     344         !                                            ! ==================== !         
    377345         l_full_nf_update = jter == nn_nevp   ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 
    378346         ! 
    … …  
    479447                  &                  ) * r1_e1e2v(ji,jj) 
    480448               ! 
    481                !                !--- u_ice at V point 
    482                u_iceV(ji,jj) = 0.5_wp * ( ( u_ice(ji,jj  ) + u_ice(ji-1,jj  ) ) * e2t(ji,jj+1)     & 
    483                   &                     + ( u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * e2t(ji,jj  ) ) * z1_e2t0(ji,jj) * vmask(ji,jj,1) 
     449               !                !--- ice currents at U-V point 
     450               v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1) 
     451               u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1) 
    484452               ! 
    485                !                !--- v_ice at U point 
    486                v_iceU(ji,jj) = 0.5_wp * ( ( v_ice(ji  ,jj) + v_ice(ji  ,jj-1) ) * e1t(ji+1,jj)     & 
    487                   &                     + ( v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * e1t(ji  ,jj) ) * z1_e1t0(ji,jj) * umask(ji,jj,1) 
    488453            END DO 
    489454         END DO 
    … …  
    504469                  !                 !--- tau_bottom/v_ice 
    505470                  zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 
    506                   zTauB = - zTauV_ib(ji,jj) / zvel 
     471                  zTauB = ztauy_base(ji,jj) / zvel 
     472                  !                 !--- OceanBottom-to-Ice stress 
     473                  ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 
    507474                  ! 
    508475                  !                 !--- Coriolis at V-points (energy conserving formulation) 
    509                   zCory(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
     476                  zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
    510477                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  & 
    511478                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 
    512479                  ! 
    513480                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    514                   zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
    515                   ! 
    516                   !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction 
    517                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauV_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     481                  zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
     482                  ! 
     483                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
     484                  !                                         1 = sliding friction : TauB < RHS 
     485                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
    518486                  ! 
    519487                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    520                   v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
    521                      &                                  + zTauE + zTauO * v_ice(ji,jj)                                            & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    522                      &                                  ) / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    523                      &                 + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    524                      &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    525                      &           ) * zmaskV(ji,jj) 
     488                     v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity 
     489                        &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     490                        &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     491                        &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
     492                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     493                        &           )   * zmsk00y(ji,jj) 
    526494                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    527                   v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                             & ! previous velocity 
    528                      &                                     + zTauE + zTauO * v_ice(ji,jj)                             & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    529                      &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )             & ! m/dt + tau_io(only ice part) + landfast 
    530                      &              + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  & ! static friction => slow decrease to v=0 
    531                      &              ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )        & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    532                      &            ) * zmaskV(ji,jj) 
     495                     v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                                       & ! previous velocity 
     496                        &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     497                        &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
     498                        &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
     499                        &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     500                        &            )   * zmsk00y(ji,jj) 
    533501                  ENDIF 
    534502               END DO 
    … …  
    540508            CALL agrif_interp_ice( 'V' ) 
    541509#endif 
    542             IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'V' ) 
     510            IF( ln_bdy )  CALL bdy_ice_dyn( 'V' ) 
    543511            ! 
    544512            DO jj = 2, jpjm1 
    … …  
    552520                  !                 !--- tau_bottom/u_ice 
    553521                  zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 
    554                   zTauB = - zTauU_ib(ji,jj) / zvel 
     522                  zTauB = ztaux_base(ji,jj) / zvel 
     523                  !                 !--- OceanBottom-to-Ice stress 
     524                  ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 
    555525                  ! 
    556526                  !                 !--- Coriolis at U-points (energy conserving formulation) 
    557                   zCorx(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
     527                  zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
    558528                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  & 
    559529                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 
    560530                  ! 
    561531                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    562                   zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
    563                   ! 
    564                   !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction 
    565                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauU_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     532                  zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
     533                  ! 
     534                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
     535                  !                                         1 = sliding friction : TauB < RHS 
     536                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
    566537                  ! 
    567538                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    568                   u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
    569                      &                                     + zTauE + zTauO * u_ice(ji,jj)                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    570                      &                                  ) / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    571                      &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )              & ! static friction => slow decrease to v=0 
    572                      &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    573                      &            ) * zmaskU(ji,jj) 
     539                     u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity 
     540                        &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     541                        &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     542                        &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
     543                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     544                        &           )   * zmsk00x(ji,jj) 
    574545                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    575                   u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                             & ! previous velocity 
    576                      &                                     + zTauE + zTauO * u_ice(ji,jj)                             & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    577                      &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )             & ! m/dt + tau_io(only ice part) + landfast 
    578                      &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  & ! static friction => slow decrease to v=0 
    579                      &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )        & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    580                      &            ) * zmaskU(ji,jj) 
     546                     u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                                       & ! previous velocity 
     547                        &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     548                        &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
     549                        &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
     550                        &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     551                        &            )   * zmsk00x(ji,jj) 
    581552                  ENDIF 
    582553               END DO 
    … …  
    588559            CALL agrif_interp_ice( 'U' ) 
    589560#endif 
    590             IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'U' ) 
     561            IF( ln_bdy )  CALL bdy_ice_dyn( 'U' ) 
    591562            ! 
    592563         ELSE ! odd iterations 
    … …  
    602573                  !                 !--- tau_bottom/u_ice 
    603574                  zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 
    604                   zTauB = - zTauU_ib(ji,jj) / zvel 
     575                  zTauB = ztaux_base(ji,jj) / zvel 
     576                  !                 !--- OceanBottom-to-Ice stress 
     577                  ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 
    605578                  ! 
    606579                  !                 !--- Coriolis at U-points (energy conserving formulation) 
    607                   zCorx(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
     580                  zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
    608581                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  & 
    609582                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 
    610583                  ! 
    611584                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    612                   zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
    613                   ! 
    614                   !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction 
    615                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauU_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     585                  zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
     586                  ! 
     587                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
     588                  !                                         1 = sliding friction : TauB < RHS 
     589                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
    616590                  ! 
    617591                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    618                   u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
    619                      &                                     + zTauE + zTauO * u_ice(ji,jj)                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    620                      &                                  ) / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    621                      &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )              & ! static friction => slow decrease to v=0 
    622                      &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    623                      &            ) * zmaskU(ji,jj) 
     592                     u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity 
     593                        &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     594                        &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     595                        &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
     596                        &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     597                        &           )   * zmsk00x(ji,jj) 
    624598                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    625                   u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                             & ! previous velocity 
    626                      &                                     + zTauE + zTauO * u_ice(ji,jj)                             & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    627                      &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )             & ! m/dt + tau_io(only ice part) + landfast 
    628                      &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  & ! static friction => slow decrease to v=0 
    629                      &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )        & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    630                      &            ) * zmaskU(ji,jj) 
     599                     u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                                       & ! previous velocity 
     600                        &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     601                        &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
     602                        &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
     603                        &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     604                        &            )   * zmsk00x(ji,jj) 
    631605                  ENDIF 
    632606               END DO 
    … …  
    638612            CALL agrif_interp_ice( 'U' ) 
    639613#endif 
    640             IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'U' ) 
     614            IF( ln_bdy )  CALL bdy_ice_dyn( 'U' ) 
    641615            ! 
    642616            DO jj = 2, jpjm1 
    … …  
    650624                  !                 !--- tau_bottom/v_ice 
    651625                  zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 
    652                   zTauB = - zTauV_ib(ji,jj) / zvel 
     626                  zTauB = ztauy_base(ji,jj) / zvel 
     627                  !                 !--- OceanBottom-to-Ice stress 
     628                  ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 
    653629                  ! 
    654630                  !                 !--- Coriolis at v-points (energy conserving formulation) 
    655                   zCory(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
     631                  zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
    656632                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  & 
    657633                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 
    658634                  ! 
    659635                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    660                   zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
    661                   ! 
    662                   !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction 
    663                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - zTauV_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     636                  zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
     637                  ! 
     638                  !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
     639                  !                                         1 = sliding friction : TauB < RHS 
     640                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
    664641                  ! 
    665642                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    666                   v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
    667                      &                                  + zTauE + zTauO * v_ice(ji,jj)                                            & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    668                      &                                  ) / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    669                      &                 + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    670                      &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    671                      &           ) * zmaskV(ji,jj) 
     643                     v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity 
     644                        &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     645                        &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     646                        &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
     647                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     648                        &           )   * zmsk00y(ji,jj) 
    672649                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    673                   v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                             & ! previous velocity 
    674                      &                                     + zTauE + zTauO * v_ice(ji,jj)                             & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    675                      &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )             & ! m/dt + tau_io(only ice part) + landfast 
    676                      &              + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  & ! static friction => slow decrease to v=0 
    677                      &              ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )        & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    678                      &            ) * zmaskV(ji,jj) 
     650                     v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                                       & ! previous velocity 
     651                        &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     652                        &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
     653                        &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
     654                        &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     655                        &            )   * zmsk00y(ji,jj) 
    679656                  ENDIF 
    680657               END DO 
    … …  
    686663            CALL agrif_interp_ice( 'V' ) 
    687664#endif 
    688             IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'V' ) 
     665            IF( ln_bdy )  CALL bdy_ice_dyn( 'V' ) 
    689666            ! 
    690667         ENDIF 
    … …  
    701678      END DO                                              !  end loop over jter  ! 
    702679      !                                                   ! ==================== ! 
    703       ! 
    704       IF( ln_bdy .AND. .NOT.ll_bdy_substep ) THEN 
    705          CALL bdy_ice_dyn( 'U' ) 
    706          CALL bdy_ice_dyn( 'V' ) 
    707       ENDIF 
    708680      ! 
    709681      !------------------------------------------------------------------------------! 
    … …  
    764736      DO jj = 1, jpj 
    765737         DO ji = 1, jpi 
    766             zswi(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 
     738            zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 
    767739         END DO 
    768740      END DO 
    769741 
     742      ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! 
     743      IF(  iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. & 
     744         & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 
     745         ! 
     746         CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1., ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1., & 
     747            &                                  ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. ) 
     748         ! 
     749         CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 
     750         CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 ) 
     751         CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 ) 
     752         CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 ) 
     753         CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 ) 
     754         CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 ) 
     755      ENDIF 
     756        
    770757      ! --- divergence, shear and strength --- ! 
    771       IF( iom_use('icediv') )   CALL iom_put( "icediv" , pdivu_i (:,:) * zswi(:,:) )   ! divergence 
    772       IF( iom_use('iceshe') )   CALL iom_put( "iceshe" , pshear_i(:,:) * zswi(:,:) )   ! shear 
    773       IF( iom_use('icestr') )   CALL iom_put( "icestr" , strength(:,:) * zswi(:,:) )   ! Ice strength 
    774  
    775       ! --- charge ellipse --- ! 
    776       IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') ) THEN 
     758      IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * zmsk00 )   ! divergence 
     759      IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! shear 
     760      IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength 
     761 
     762      ! --- stress tensor --- ! 
     763      IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') .OR. iom_use('normstr') .OR. iom_use('sheastr') ) THEN 
    777764         ! 
    778765         ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) ) 
    … …  
    780767         DO jj = 2, jpjm1 
    781768            DO ji = 2, jpim1 
    782                zdum1 = ( zswi(ji-1,jj) * pstress12_i(ji-1,jj) + zswi(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point 
    783                   &      zswi(ji  ,jj) * pstress12_i(ji  ,jj) + zswi(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  & 
    784                   &    / MAX( 1._wp, zswi(ji-1,jj) + zswi(ji,jj-1) + zswi(ji,jj) + zswi(ji-1,jj-1) ) 
     769               zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point 
     770                  &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  & 
     771                  &    / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 
    785772 
    786773               zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress   
    787774 
    788                zdum2 = zswi(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 
     775               zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 
    789776 
    790777!!               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002) 
    … …  
    799786         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. ) 
    800787         ! 
    801          IF( iom_use('isig1') )   CALL iom_put( "isig1" , zsig1 ) 
    802          IF( iom_use('isig2') )   CALL iom_put( "isig2" , zsig2 ) 
    803          IF( iom_use('isig3') )   CALL iom_put( "isig3" , zsig3 ) 
    804          ! 
     788         CALL iom_put( 'isig1' , zsig1 ) 
     789         CALL iom_put( 'isig2' , zsig2 ) 
     790         CALL iom_put( 'isig3' , zsig3 ) 
     791         ! 
     792         ! Stress tensor invariants (normal and shear stress N/m) 
     793         IF( iom_use('normstr') )   CALL iom_put( 'normstr' ,       ( zs1(:,:) + zs2(:,:) )                       * zmsk00(:,:) ) ! Normal stress 
     794         IF( iom_use('sheastr') )   CALL iom_put( 'sheastr' , SQRT( ( zs1(:,:) - zs2(:,:) )**2 + 4*zs12(:,:)**2 ) * zmsk00(:,:) ) ! Shear stress 
     795 
    805796         DEALLOCATE( zsig1 , zsig2 , zsig3 ) 
    806797      ENDIF 
    807798       
    808799      ! --- SIMIP --- ! 
    809       IF ( iom_use( 'normstr'  ) .OR. iom_use( 'sheastr'  ) .OR. iom_use( 'dssh_dx'  ) .OR. iom_use( 'dssh_dy'  ) .OR. & 
    810          & iom_use( 'corstrx'  ) .OR. iom_use( 'corstry'  ) .OR. iom_use( 'intstrx'  ) .OR. iom_use( 'intstry'  ) .OR. & 
    811          & iom_use( 'utau_oi'  ) .OR. iom_use( 'vtau_oi'  ) .OR. iom_use( 'xmtrpice' ) .OR. iom_use( 'ymtrpice' ) .OR. & 
    812          & iom_use( 'xmtrpsnw' ) .OR. iom_use( 'ymtrpsnw' ) .OR. iom_use( 'xatrp'    ) .OR. iom_use( 'yatrp'    ) ) THEN 
    813  
    814          ALLOCATE( zdiag_sig1     (jpi,jpj) , zdiag_sig2     (jpi,jpj) , zdiag_dssh_dx  (jpi,jpj) , zdiag_dssh_dy  (jpi,jpj) ,  & 
    815             &      zdiag_corstrx  (jpi,jpj) , zdiag_corstry  (jpi,jpj) , zdiag_intstrx  (jpi,jpj) , zdiag_intstry  (jpi,jpj) ,  & 
    816             &      zdiag_utau_oi  (jpi,jpj) , zdiag_vtau_oi  (jpi,jpj) , zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) ,  & 
    817             &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp    (jpi,jpj) , zdiag_yatrp    (jpi,jpj) ) 
    818           
     800      IF(  iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. & 
     801         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 
     802         ! 
     803         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1., zspgV, 'V', -1., & 
     804            &                                  zCorU, 'U', -1., zCorV, 'V', -1., zfU, 'U', -1., zfV, 'V', -1. ) 
     805 
     806         CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x) 
     807         CALL iom_put( 'dssh_dy' , zspgV * zmsk00 )   ! Sea-surface tilt term in force balance (y) 
     808         CALL iom_put( 'corstrx' , zCorU * zmsk00 )   ! Coriolis force term in force balance (x) 
     809         CALL iom_put( 'corstry' , zCorV * zmsk00 )   ! Coriolis force term in force balance (y) 
     810         CALL iom_put( 'intstrx' , zfU   * zmsk00 )   ! Internal force term in force balance (x) 
     811         CALL iom_put( 'intstry' , zfV   * zmsk00 )   ! Internal force term in force balance (y) 
     812      ENDIF 
     813 
     814      IF(  iom_use('xmtrpice') .OR. iom_use('ymtrpice') .OR. & 
     815         & iom_use('xmtrpsnw') .OR. iom_use('ymtrpsnw') .OR. iom_use('xatrp') .OR. iom_use('yatrp') ) THEN 
     816         ! 
     817         ALLOCATE( zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , & 
     818            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) ) 
     819         ! 
    819820         DO jj = 2, jpjm1 
    820821            DO ji = 2, jpim1 
    821                rswitch  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 
    822                 
    823                ! Stress tensor invariants (normal and shear stress N/m) 
    824                zdiag_sig1(ji,jj) = ( zs1(ji,jj) + zs2(ji,jj) ) * rswitch                                 ! normal stress 
    825                zdiag_sig2(ji,jj) = SQRT( ( zs1(ji,jj) - zs2(ji,jj) )**2 + 4*zs12(ji,jj)**2 ) * rswitch   ! shear stress 
    826                 
    827                ! Stress terms of the momentum equation (N/m2) 
    828                zdiag_dssh_dx(ji,jj) = zspgU(ji,jj) * rswitch     ! sea surface slope stress term 
    829                zdiag_dssh_dy(ji,jj) = zspgV(ji,jj) * rswitch 
    830                 
    831                zdiag_corstrx(ji,jj) = zCorx(ji,jj) * rswitch     ! Coriolis stress term 
    832                zdiag_corstry(ji,jj) = zCory(ji,jj) * rswitch 
    833                 
    834                zdiag_intstrx(ji,jj) = zfU(ji,jj)   * rswitch     ! internal stress term 
    835                zdiag_intstry(ji,jj) = zfV(ji,jj)   * rswitch 
    836                 
    837                zdiag_utau_oi(ji,jj) = ztaux_oi(ji,jj) * rswitch  ! oceanic stress 
    838                zdiag_vtau_oi(ji,jj) = ztauy_oi(ji,jj) * rswitch 
    839                 
    840822               ! 2D ice mass, snow mass, area transport arrays (X, Y) 
    841                zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * rswitch 
    842                zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * rswitch 
    843                 
     823               zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 
     824               zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 
     825 
    844826               zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 
    845827               zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   '' 
    846                 
     828 
    847829               zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component 
    848830               zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   '' 
    849                 
     831 
    850832               zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component 
    851833               zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   '' 
    852                 
    853             END DO 
    854          END DO 
    855           
    856          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_sig1   , 'T',  1., zdiag_sig2   , 'T',  1.,   & 
    857             &                zdiag_dssh_dx, 'U', -1., zdiag_dssh_dy, 'V', -1.,   & 
    858             &                zdiag_corstrx, 'U', -1., zdiag_corstry, 'V', -1.,   &  
    859             &                zdiag_intstrx, 'U', -1., zdiag_intstry, 'V', -1.    ) 
    860                    
    861          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_utau_oi  , 'U', -1., zdiag_vtau_oi  , 'V', -1.,   & 
    862             &                zdiag_xmtrp_ice, 'U', -1., zdiag_xmtrp_snw, 'U', -1.,   & 
    863             &                zdiag_xatrp    , 'U', -1., zdiag_ymtrp_ice, 'V', -1.,   & 
    864             &                zdiag_ymtrp_snw, 'V', -1., zdiag_yatrp    , 'V', -1.    ) 
    865           
    866          IF( iom_use('normstr' ) )   CALL iom_put( 'normstr'  ,  zdiag_sig1(:,:)      )   ! Normal stress 
    867          IF( iom_use('sheastr' ) )   CALL iom_put( 'sheastr'  ,  zdiag_sig2(:,:)      )   ! Shear stress 
    868          IF( iom_use('dssh_dx' ) )   CALL iom_put( 'dssh_dx'  ,  zdiag_dssh_dx(:,:)   )   ! Sea-surface tilt term in force balance (x) 
    869          IF( iom_use('dssh_dy' ) )   CALL iom_put( 'dssh_dy'  ,  zdiag_dssh_dy(:,:)   )   ! Sea-surface tilt term in force balance (y) 
    870          IF( iom_use('corstrx' ) )   CALL iom_put( 'corstrx'  ,  zdiag_corstrx(:,:)   )   ! Coriolis force term in force balance (x) 
    871          IF( iom_use('corstry' ) )   CALL iom_put( 'corstry'  ,  zdiag_corstry(:,:)   )   ! Coriolis force term in force balance (y) 
    872          IF( iom_use('intstrx' ) )   CALL iom_put( 'intstrx'  ,  zdiag_intstrx(:,:)   )   ! Internal force term in force balance (x) 
    873          IF( iom_use('intstry' ) )   CALL iom_put( 'intstry'  ,  zdiag_intstry(:,:)   )   ! Internal force term in force balance (y) 
    874          IF( iom_use('utau_oi' ) )   CALL iom_put( 'utau_oi'  ,  zdiag_utau_oi(:,:)   )   ! Ocean stress term in force balance (x) 
    875          IF( iom_use('vtau_oi' ) )   CALL iom_put( 'vtau_oi'  ,  zdiag_vtau_oi(:,:)   )   ! Ocean stress term in force balance (y) 
    876          IF( iom_use('xmtrpice') )   CALL iom_put( 'xmtrpice' ,  zdiag_xmtrp_ice(:,:) )   ! X-component of sea-ice mass transport (kg/s) 
    877          IF( iom_use('ymtrpice') )   CALL iom_put( 'ymtrpice' ,  zdiag_ymtrp_ice(:,:) )   ! Y-component of sea-ice mass transport  
    878          IF( iom_use('xmtrpsnw') )   CALL iom_put( 'xmtrpsnw' ,  zdiag_xmtrp_snw(:,:) )   ! X-component of snow mass transport (kg/s) 
    879          IF( iom_use('ymtrpsnw') )   CALL iom_put( 'ymtrpsnw' ,  zdiag_ymtrp_snw(:,:) )   ! Y-component of snow mass transport 
    880          IF( iom_use('xatrp'   ) )   CALL iom_put( 'xatrp'    ,  zdiag_xatrp(:,:)     )   ! X-component of ice area transport 
    881          IF( iom_use('yatrp'   ) )   CALL iom_put( 'yatrp'    ,  zdiag_yatrp(:,:)     )   ! Y-component of ice area transport 
    882  
    883          DEALLOCATE( zdiag_sig1      , zdiag_sig2      , zdiag_dssh_dx   , zdiag_dssh_dy   ,  & 
    884             &        zdiag_corstrx   , zdiag_corstry   , zdiag_intstrx   , zdiag_intstry   ,  & 
    885             &        zdiag_utau_oi   , zdiag_vtau_oi   , zdiag_xmtrp_ice , zdiag_ymtrp_ice ,  & 
    886             &        zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp     , zdiag_yatrp     ) 
     834 
     835            END DO 
     836         END DO 
     837 
     838         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 
     839            &                                  zdiag_xmtrp_snw, 'U', -1., zdiag_ymtrp_snw, 'V', -1., & 
     840            &                                  zdiag_xatrp    , 'U', -1., zdiag_yatrp    , 'V', -1. ) 
     841 
     842         CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice )   ! X-component of sea-ice mass transport (kg/s) 
     843         CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice )   ! Y-component of sea-ice mass transport  
     844         CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw )   ! X-component of snow mass transport (kg/s) 
     845         CALL iom_put( 'ymtrpsnw' , zdiag_ymtrp_snw )   ! Y-component of snow mass transport 
     846         CALL iom_put( 'xatrp'    , zdiag_xatrp     )   ! X-component of ice area transport 
     847         CALL iom_put( 'yatrp'    , zdiag_yatrp     )   ! Y-component of ice area transport 
     848 
     849         DEALLOCATE( zdiag_xmtrp_ice , zdiag_ymtrp_ice , & 
     850            &        zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp , zdiag_yatrp ) 
    887851 
    888852      ENDIF 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/iceistate.F90

    r11229 r11692  
    2222   USE eosbn2         ! equation of state 
    2323   USE domvvl         ! Variable volume 
    24    USE ice            ! sea-ice variables 
    25    USE icevar         ! ice_var_salprof 
     24   USE ice            ! sea-ice: variables 
     25   USE ice1D          ! sea-ice: thermodynamics variables 
     26   USE icetab         ! sea-ice: 1D <==> 2D transformation 
     27   USE icevar         ! sea-ice: operations 
    2628   ! 
    2729   USE in_out_manager ! I/O manager 
    … …  
    3638   PUBLIC   ice_istate        ! called by icestp.F90 
    3739   PUBLIC   ice_istate_init   ! called by icestp.F90 
    38  
    39    INTEGER , PARAMETER ::   jpfldi = 6           ! maximum number of files to read 
    40    INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness (m)    at T-point 
    41    INTEGER , PARAMETER ::   jp_hts = 2           ! index of snow thicknes (m)    at T-point 
    42    INTEGER , PARAMETER ::   jp_ati = 3           ! index of ice fraction (%) at T-point 
    43    INTEGER , PARAMETER ::   jp_tsu = 4           ! index of ice surface temp (K)    at T-point 
    44    INTEGER , PARAMETER ::   jp_tmi = 5           ! index of ice temp at T-point 
    45    INTEGER , PARAMETER ::   jp_smi = 6           ! index of ice sali at T-point 
    46    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    4740   ! 
    4841   !                             !! ** namelist (namini) ** 
    49    LOGICAL  ::   ln_iceini        ! initialization or not 
    50    LOGICAL  ::   ln_iceini_file   ! Ice initialization state from 2D netcdf file 
    51    REAL(wp) ::   rn_thres_sst     ! threshold water temperature for initial sea ice 
    52    REAL(wp) ::   rn_hts_ini_n     ! initial snow thickness in the north 
    53    REAL(wp) ::   rn_hts_ini_s     ! initial snow thickness in the south 
    54    REAL(wp) ::   rn_hti_ini_n     ! initial ice thickness in the north 
    55    REAL(wp) ::   rn_hti_ini_s     ! initial ice thickness in the south 
    56    REAL(wp) ::   rn_ati_ini_n     ! initial leads area in the north 
    57    REAL(wp) ::   rn_ati_ini_s     ! initial leads area in the south 
    58    REAL(wp) ::   rn_smi_ini_n     ! initial salinity  
    59    REAL(wp) ::   rn_smi_ini_s     ! initial salinity 
    60    REAL(wp) ::   rn_tmi_ini_n     ! initial temperature 
    61    REAL(wp) ::   rn_tmi_ini_s     ! initial temperature 
    62     
     42   LOGICAL, PUBLIC  ::   ln_iceini        !: Ice initialization or not 
     43   LOGICAL, PUBLIC  ::   ln_iceini_file   !: Ice initialization from 2D netcdf file 
     44   REAL(wp) ::   rn_thres_sst 
     45   REAL(wp) ::   rn_hti_ini_n, rn_hts_ini_n, rn_ati_ini_n, rn_smi_ini_n, rn_tmi_ini_n, rn_tsu_ini_n, rn_tms_ini_n 
     46   REAL(wp) ::   rn_hti_ini_s, rn_hts_ini_s, rn_ati_ini_s, rn_smi_ini_s, rn_tmi_ini_s, rn_tsu_ini_s, rn_tms_ini_s 
     47   REAL(wp) ::   rn_apd_ini_n, rn_hpd_ini_n 
     48   REAL(wp) ::   rn_apd_ini_s, rn_hpd_ini_s 
     49   ! 
     50   !                              ! if ln_iceini_file = T 
     51   INTEGER , PARAMETER ::   jpfldi = 9           ! maximum number of files to read 
     52   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness    (m) 
     53   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snw thickness    (m) 
     54   INTEGER , PARAMETER ::   jp_ati = 3           ! index of ice fraction     (-) 
     55   INTEGER , PARAMETER ::   jp_smi = 4           ! index of ice salinity     (g/kg) 
     56   INTEGER , PARAMETER ::   jp_tmi = 5           ! index of ice temperature  (K) 
     57   INTEGER , PARAMETER ::   jp_tsu = 6           ! index of ice surface temp (K) 
     58   INTEGER , PARAMETER ::   jp_tms = 7           ! index of snw temperature  (K) 
     59   INTEGER , PARAMETER ::   jp_apd = 8           ! index of pnd fraction     (-) 
     60   INTEGER , PARAMETER ::   jp_hpd = 9           ! index of pnd depth        (m) 
     61   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
     62   !    
    6363   !!---------------------------------------------------------------------- 
    6464   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    6868CONTAINS 
    6969 
    70    SUBROUTINE ice_istate 
     70   SUBROUTINE ice_istate( kt ) 
    7171      !!------------------------------------------------------------------- 
    7272      !!                    ***  ROUTINE ice_istate  *** 
    … …  
    8787      !! 
    8888      !! ** Notes   : o_i, t_su, t_s, t_i, sz_i must be filled everywhere, even 
    89       !!              where there is no ice (clem: I do not know why, is it mandatory?)  
     89      !!              where there is no ice 
    9090      !!-------------------------------------------------------------------- 
     91      INTEGER, INTENT(in) ::   kt   ! time step  
     92      !! 
    9193      INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices 
    92       INTEGER  ::   i_hemis, i_fill, jl0   ! local integers 
    93       REAL(wp) ::   ztmelts, zdh 
    94       REAL(wp) ::   zarg, zV, zconv, zdv, zfac 
     94      REAL(wp) ::   ztmelts 
    9595      INTEGER , DIMENSION(4)           ::   itest 
    9696      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d 
    9797      REAL(wp), DIMENSION(jpi,jpj)     ::   zswitch    ! ice indicator 
    98       REAL(wp), DIMENSION(jpi,jpj)     ::   zht_i_ini, zat_i_ini, zvt_i_ini            !data from namelist or nc file 
    99       REAL(wp), DIMENSION(jpi,jpj)     ::   zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 
    100       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zh_i_ini , za_i_ini                        !data by cattegories to fill 
     98      REAL(wp), DIMENSION(jpi,jpj)     ::   zht_i_ini, zat_i_ini, ztm_s_ini            !data from namelist or nc file 
     99      REAL(wp), DIMENSION(jpi,jpj)     ::   zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 
     100      REAL(wp), DIMENSION(jpi,jpj)     ::   zapnd_ini, zhpnd_ini                       !data from namelist or nc file 
     101      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zti_3d , zts_3d                            !temporary arrays 
     102      !! 
     103      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 
    101104      !-------------------------------------------------------------------- 
    102105 
    … …  
    105108      IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    106109 
    107       !-------------------------------------------------------------------- 
    108       ! 1) Set surface and bottom temperatures to initial values 
    109       !-------------------------------------------------------------------- 
    110       ! 
    111       ! init surface temperature 
     110      !--------------------------- 
     111      ! 1) 1st init. of the fields 
     112      !--------------------------- 
     113      ! 
     114      ! basal temperature (considered at freezing point)   [Kelvin] 
     115      CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 
     116      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)  
     117      ! 
     118      ! surface temperature and conductivity 
    112119      DO jl = 1, jpl 
    113120         t_su   (:,:,jl) = rt0 * tmask(:,:,1)  ! temp at the surface 
    … …  
    115122      END DO 
    116123      ! 
    117       ! init basal temperature (considered at freezing point)   [Kelvin] 
    118       CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 
    119       t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)  
    120  
     124      ! ice and snw temperatures 
     125      DO jl = 1, jpl 
     126         DO jk = 1, nlay_i 
     127            t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 
     128         END DO 
     129         DO jk = 1, nlay_s 
     130            t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 
     131         END DO 
     132      END DO 
     133      ! 
     134      ! specific temperatures for coupled runs 
     135      tn_ice (:,:,:) = t_i (:,:,1,:) 
     136      t1_ice (:,:,:) = t_i (:,:,1,:) 
     137 
     138      ! heat contents 
     139      e_i (:,:,:,:) = 0._wp 
     140      e_s (:,:,:,:) = 0._wp 
     141       
     142      ! general fields 
     143      a_i (:,:,:) = 0._wp 
     144      v_i (:,:,:) = 0._wp 
     145      v_s (:,:,:) = 0._wp 
     146      sv_i(:,:,:) = 0._wp 
     147      oa_i(:,:,:) = 0._wp 
     148      ! 
     149      h_i (:,:,:) = 0._wp 
     150      h_s (:,:,:) = 0._wp 
     151      s_i (:,:,:) = 0._wp 
     152      o_i (:,:,:) = 0._wp 
     153      ! 
     154      ! melt ponds 
     155      a_ip     (:,:,:) = 0._wp 
     156      v_ip     (:,:,:) = 0._wp 
     157      a_ip_frac(:,:,:) = 0._wp 
     158      h_ip     (:,:,:) = 0._wp 
     159      ! 
     160      ! ice velocities 
     161      u_ice (:,:) = 0._wp 
     162      v_ice (:,:) = 0._wp 
     163      ! 
     164      !------------------------------------------------------------------------ 
     165      ! 2) overwrite some of the fields with namelist parameters or netcdf file 
     166      !------------------------------------------------------------------------ 
    121167      IF( ln_iceini ) THEN 
    122          !----------------------------------------------------------- 
    123          ! 2) Compute or read sea ice variables ===> single category 
    124          !----------------------------------------------------------- 
    125          ! 
    126168         !                             !---------------! 
    127169         IF( ln_iceini_file )THEN      ! Read a file   ! 
    128170            !                          !---------------! 
    129             ! 
    130             zht_i_ini(:,:)  = si(jp_hti)%fnow(:,:,1) 
    131             zht_s_ini(:,:)  = si(jp_hts)%fnow(:,:,1) 
    132             zat_i_ini(:,:)  = si(jp_ati)%fnow(:,:,1) 
    133             zts_u_ini(:,:)  = si(jp_tsu)%fnow(:,:,1) 
    134             ztm_i_ini(:,:)  = si(jp_tmi)%fnow(:,:,1) 
    135             zsm_i_ini(:,:)  = si(jp_smi)%fnow(:,:,1) 
    136             ! 
    137             WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1)  
    138             ELSEWHERE                       ; zswitch(:,:) = 0._wp 
     171            WHERE( ff_t(:,:) >= 0._wp )   ;   zswitch(:,:) = 1._wp 
     172            ELSEWHERE                     ;   zswitch(:,:) = 0._wp 
    139173            END WHERE 
    140             zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) 
    141             ! 
     174            ! 
     175            CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step 
     176            ! 
     177            ! -- mandatory fields -- ! 
     178            zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 
     179            zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) 
     180            zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) 
     181 
     182            ! -- optional fields -- ! 
     183            !    if fields do not exist then set them to the values present in the namelist (except for snow and surface temperature) 
     184            ! 
     185            ! ice salinity 
     186            IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & 
     187               &     si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     188            zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 
     189            ! 
     190            ! ice temperature 
     191            IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) & 
     192               &     si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     193            ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 
     194            ! 
     195            ! surface temperature => set to ice temperature if it exists 
     196            IF    ( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) THEN 
     197                     si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     198            ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN 
     199                     si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
     200            ENDIF 
     201            zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) 
     202            ! 
     203            ! snow temperature => set to ice temperature if it exists 
     204            IF    ( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) == 'NOT USED' ) THEN 
     205                     si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     206            ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN 
     207                     si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
     208            ENDIF 
     209            ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) 
     210            ! 
     211            ! pond concentration 
     212            IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 
     213               &     si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. 
     214               &                              * si(jp_ati)%fnow(:,:,1)  
     215            zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) 
     216            ! 
     217            ! pond depth 
     218            IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 
     219               &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     220            zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) 
     221            ! 
     222            ! change the switch for the following 
     223            WHERE( zat_i_ini(:,:) > 0._wp )   ;   zswitch(:,:) = tmask(:,:,1)  
     224            ELSEWHERE                         ;   zswitch(:,:) = 0._wp 
     225            END WHERE 
    142226            !                          !---------------! 
    143227         ELSE                          ! Read namelist ! 
    144228            !                          !---------------! 
    145             ! no ice if sst <= t-freez + ttest 
     229            ! no ice if (sst - Tfreez) >= thresold 
    146230            WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst )   ;   zswitch(:,:) = 0._wp  
    147231            ELSEWHERE                                                                    ;   zswitch(:,:) = tmask(:,:,1) 
    … …  
    153237               zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:) 
    154238               zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:) 
    155                zts_u_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 
    156239               zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:) 
    157240               ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 
     241               zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 
     242               ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 
     243               zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.  
     244               zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 
    158245            ELSEWHERE 
    159246               zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 
    160247               zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:) 
    161248               zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:) 
    162                zts_u_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 
    163249               zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:) 
    164250               ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 
     251               zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 
     252               ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 
     253               zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
     254               zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 
    165255            END WHERE 
    166             zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:) 
    167             ! 
     256            ! 
     257         ENDIF 
     258 
     259         ! make sure ponds = 0 if no ponds scheme 
     260         IF ( .NOT.ln_pnd ) THEN 
     261            zapnd_ini(:,:) = 0._wp 
     262            zhpnd_ini(:,:) = 0._wp 
    168263         ENDIF 
    169264          
    170          !------------------------------------------------------------------ 
    171          ! 3) Distribute ice concentration and thickness into the categories 
    172          !------------------------------------------------------------------ 
    173          ! a gaussian distribution for ice concentration is used 
    174          ! then we check whether the distribution fullfills 
    175          ! volume and area conservation, positivity and ice categories bounds 
    176  
    177          IF( jpl == 1 ) THEN 
    178             ! 
    179             zh_i_ini(:,:,1) = zht_i_ini(:,:) 
    180             za_i_ini(:,:,1) = zat_i_ini(:,:)             
    181             ! 
    182          ELSE 
    183             zh_i_ini(:,:,:) = 0._wp  
    184             za_i_ini(:,:,:) = 0._wp 
    185             ! 
     265         !-------------! 
     266         ! fill fields ! 
     267         !-------------! 
     268         ! select ice covered grid points 
     269         npti = 0 ; nptidx(:) = 0 
     270         DO jj = 1, jpj 
     271            DO ji = 1, jpi 
     272               IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 
     273                  npti         = npti  + 1 
     274                  nptidx(npti) = (jj - 1) * jpi + ji 
     275               ENDIF 
     276            END DO 
     277         END DO 
     278 
     279         ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 
     280         CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti)  , zht_i_ini ) 
     281         CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti)  , zht_s_ini ) 
     282         CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti)  , zat_i_ini ) 
     283         CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) 
     284         CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) 
     285         CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti)  , zt_su_ini ) 
     286         CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti)  , zsm_i_ini ) 
     287         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti)  , zapnd_ini ) 
     288         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini ) 
     289 
     290         ! allocate temporary arrays 
     291         ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 
     292            &      zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 
     293          
     294         ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 
     295         CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                                                   & 
     296            &              zhi_2d          , zhs_2d          , zai_2d         ,                                                   & 
     297            &              t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti), a_ip_1d(1:npti), h_ip_1d(1:npti), & 
     298            &              zti_2d          , zts_2d          , ztsu_2d        , zsi_2d        , zaip_2d        , zhip_2d ) 
     299 
     300         ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 
     301         DO jl = 1, jpl 
     302            zti_3d(:,:,jl) = rt0 * tmask(:,:,1) 
     303            zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 
     304         END DO 
     305         CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d   , h_i    ) 
     306         CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d   , h_s    ) 
     307         CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d   , a_i    ) 
     308         CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d   , zti_3d ) 
     309         CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d   , zts_3d ) 
     310         CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d  , t_su   ) 
     311         CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d   , s_i    ) 
     312         CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d  , a_ip   ) 
     313         CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d  , h_ip   ) 
     314 
     315         ! deallocate temporary arrays 
     316         DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 
     317            &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 
     318 
     319         ! calculate extensive and intensive variables 
     320         CALL ice_var_salprof ! for sz_i 
     321         DO jl = 1, jpl 
    186322            DO jj = 1, jpj 
    187323               DO ji = 1, jpi 
    188                   ! 
    189                   IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN 
    190  
    191                      ! find which category (jl0) the input ice thickness falls into 
    192                      jl0 = jpl 
    193                      DO jl = 1, jpl 
    194                         IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN 
    195                            jl0 = jl 
    196                            CYCLE 
    197                         ENDIF 
    198                      END DO 
    199                      ! 
    200                      itest(:) = 0 
    201                      i_fill   = jpl + 1                                            !------------------------------------ 
    202                      DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )   ! iterative loop on i_fill categories 
    203                         !                                                          !------------------------------------ 
    204                         i_fill = i_fill - 1 
    205                         ! 
    206                         zh_i_ini(ji,jj,:) = 0._wp  
    207                         za_i_ini(ji,jj,:) = 0._wp 
    208                         itest(:) = 0 
    209                         ! 
    210                         IF ( i_fill == 1 ) THEN      !-- case very thin ice: fill only category 1 
    211                            zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj) 
    212                            za_i_ini(ji,jj,1) = zat_i_ini(ji,jj) 
    213                         ELSE                         !-- case ice is thicker: fill categories >1 
    214                            ! thickness 
    215                            DO jl = 1, i_fill-1 
    216                               zh_i_ini(ji,jj,jl) = hi_mean(jl) 
    217                            END DO 
    218                            ! 
    219                            ! concentration 
    220                            za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) 
    221                            DO jl = 1, i_fill - 1 
    222                               IF( jl /= jl0 )THEN 
    223                                  zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) ) 
    224                                  za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2) 
    225                               ENDIF 
    226                            END DO 
    227  
    228                            ! last category 
    229                            za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) ) 
    230                            zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) ) 
    231                            zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 )  
    232  
    233                            ! correction if concentration of upper cat is greater than lower cat 
    234                            !   (it should be a gaussian around jl0 but sometimes it is not) 
    235                            IF ( jl0 /= jpl ) THEN 
    236                               DO jl = jpl, jl0+1, -1 
    237                                  IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN 
    238                                     zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl) 
    239                                     zh_i_ini(ji,jj,jl    ) = 0._wp 
    240                                     za_i_ini(ji,jj,jl    ) = 0._wp 
    241                                     za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1)  & 
    242                                        &                     + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 ) 
    243                                  END IF 
    244                               ENDDO 
    245                            ENDIF 
    246                            ! 
    247                         ENDIF 
    248                         ! 
    249                         ! Compatibility tests 
    250                         zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) )           ! Test 1: area conservation 
    251                         IF ( zconv < epsi06 ) itest(1) = 1 
    252                         ! 
    253                         zconv = ABS(       zat_i_ini(ji,jj)       * zht_i_ini(ji,jj)   &         ! Test 2: volume conservation 
    254                            &        - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) ) 
    255                         IF ( zconv < epsi06 ) itest(2) = 1 
    256                         ! 
    257                         IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1           ! Test 3: thickness of the last category is in-bounds ? 
    258                         ! 
    259                         itest(4) = 1 
    260                         DO jl = 1, i_fill 
    261                            IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0                        ! Test 4: positivity of ice concentrations 
    262                         END DO 
    263                         !                                                          !---------------------------- 
    264                      END DO                                                        ! end iteration on categories 
    265                      !                                                             !---------------------------- 
    266                      IF( lwp .AND. SUM(itest) /= 4 ) THEN  
    267                         WRITE(numout,*) 
    268                         WRITE(numout,*) ' !!!! ALERT itest is not equal to 4      !!! ' 
    269                         WRITE(numout,*) ' !!!! Something is wrong in the SI3 initialization procedure ' 
    270                         WRITE(numout,*) 
    271                         WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:) 
    272                         WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj) 
    273                         WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj) 
    274                      ENDIF 
    275                      ! 
    276                   ENDIF 
    277                   ! 
     324                  v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 
     325                  v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 
     326                  sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 
    278327               END DO 
    279328            END DO 
    280          ENDIF 
    281           
    282          !--------------------------------------------------------------------- 
    283          ! 4) Fill in sea ice arrays 
    284          !--------------------------------------------------------------------- 
    285          ! 
    286          ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature 
    287          DO jl = 1, jpl ! loop over categories 
    288             DO jj = 1, jpj 
    289                DO ji = 1, jpi 
    290                   a_i(ji,jj,jl)  = zswitch(ji,jj) * za_i_ini(ji,jj,jl)                       ! concentration 
    291                   h_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(ji,jj,jl)                       ! ice thickness 
    292                   s_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(ji,jj)                         ! salinity 
    293                   o_i(ji,jj,jl)  = 0._wp                                                     ! age (0 day) 
    294                   t_su(ji,jj,jl) = zswitch(ji,jj) * zts_u_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 
    295                   ! 
    296                   IF( zht_i_ini(ji,jj) > 0._wp )THEN 
    297                     h_s(ji,jj,jl)= h_i(ji,jj,jl) * ( zht_s_ini(ji,jj) / zht_i_ini(ji,jj) )  ! snow depth 
    298                   ELSE 
    299                     h_s(ji,jj,jl)= 0._wp 
    300                   ENDIF 
    301                   ! 
    302                   ! This case below should not be used if (h_s/h_i) is ok in namelist 
    303                   ! In case snow load is in excess that would lead to transformation from snow to ice 
    304                   ! Then, transfer the snow excess into the ice (different from icethd_dh) 
    305                   zdh = MAX( 0._wp, ( rhos * h_s(ji,jj,jl) + ( rhoi - rau0 ) * h_i(ji,jj,jl) ) * r1_rau0 )  
    306                   ! recompute h_i, h_s avoiding out of bounds values 
    307                   h_i(ji,jj,jl) = MIN( hi_max(jl), h_i(ji,jj,jl) + zdh ) 
    308                   h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoi * r1_rhos ) 
    309                   ! 
    310                   ! ice volume, salt content, age content 
    311                   v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume 
    312                   v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume 
    313                   sv_i(ji,jj,jl) = MIN( s_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content 
    314                   oa_i(ji,jj,jl) = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content 
    315                END DO 
    316             END DO 
    317          END DO 
    318          ! 
    319          IF( nn_icesal /= 2 )  THEN         ! for constant salinity in time 
    320             CALL ice_var_salprof 
    321             sv_i = s_i * v_i 
    322          ENDIF 
    323          !   
    324          ! Snow temperature and heat content 
    325          DO jk = 1, nlay_s 
    326             DO jl = 1, jpl ! loop over categories 
     329         END DO 
     330         ! 
     331         DO jl = 1, jpl 
     332            DO jk = 1, nlay_s 
    327333               DO jj = 1, jpj 
    328334                  DO ji = 1, jpi 
    329                      t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 
    330                      ! Snow energy of melting 
    331                      e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
    332                      ! 
    333                      ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 
    334                      e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 
     335                     t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 
     336                     e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 
     337                        &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
    335338                  END DO 
    336339               END DO 
    … …  
    338341         END DO 
    339342         ! 
    340          ! Ice salinity, temperature and heat content 
    341          DO jk = 1, nlay_i 
    342             DO jl = 1, jpl ! loop over categories 
     343         DO jl = 1, jpl 
     344            DO jk = 1, nlay_i 
    343345               DO jj = 1, jpj 
    344346                  DO ji = 1, jpi 
    345                      t_i (ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0  
    346                      sz_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rn_simin 
    347                      ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 !Melting temperature in K 
    348                      ! 
    349                      ! heat content per unit volume 
    350                      e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoi * (   rcpi    * ( ztmelts - t_i(ji,jj,jk,jl) )           & 
    351                         &             + rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0) , -epsi20 )  )   & 
    352                         &             - rcp  * ( ztmelts - rt0 ) ) 
    353                      ! 
    354                      ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 
    355                      e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 
     347                     t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
     348                     ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 
     349                     e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 
     350                        &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 
     351                        &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 
     352                        &                       - rcp   * ( ztmelts - rt0 ) ) 
    356353                  END DO 
    357354               END DO 
    358355            END DO 
    359356         END DO 
    360          ! 
    361          tn_ice (:,:,:) = t_su (:,:,:) 
    362          t1_ice (:,:,:) = t_i (:,:,1,:)   ! initialisation of 1st layer temp for coupled simu 
    363  
    364          ! Melt pond volume and fraction 
    365          IF ( ln_pnd_CST .OR. ln_pnd_H12 ) THEN   ;   zfac = 1._wp 
    366          ELSE                                     ;   zfac = 0._wp 
    367          ENDIF  
    368          DO jl = 1, jpl 
    369             a_ip_frac(:,:,jl) = rn_apnd * zswitch(:,:) * zfac 
    370             h_ip     (:,:,jl) = rn_hpnd * zswitch(:,:) * zfac 
    371          END DO 
    372          a_ip(:,:,:) = a_ip_frac(:,:,:) * a_i (:,:,:)  
    373          v_ip(:,:,:) = h_ip     (:,:,:) * a_ip(:,:,:) 
    374          ! 
    375       ELSE ! if ln_iceini=false 
    376          a_i  (:,:,:) = 0._wp 
    377          v_i  (:,:,:) = 0._wp 
    378          v_s  (:,:,:) = 0._wp 
    379          sv_i (:,:,:) = 0._wp 
    380          oa_i (:,:,:) = 0._wp 
    381          h_i  (:,:,:) = 0._wp 
    382          h_s  (:,:,:) = 0._wp 
    383          s_i  (:,:,:) = 0._wp 
    384          o_i  (:,:,:) = 0._wp 
    385          ! 
    386          e_i(:,:,:,:) = 0._wp 
    387          e_s(:,:,:,:) = 0._wp 
    388          ! 
    389          DO jl = 1, jpl 
    390             DO jk = 1, nlay_i 
    391                t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 
    392             END DO 
    393             DO jk = 1, nlay_s 
    394                t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 
    395             END DO 
    396          END DO 
    397  
    398          tn_ice (:,:,:) = t_i (:,:,1,:) 
    399          t1_ice (:,:,:) = t_i (:,:,1,:)   ! initialisation of 1st layer temp for coupled simu 
    400           
    401          a_ip(:,:,:)      = 0._wp 
    402          v_ip(:,:,:)      = 0._wp 
    403          a_ip_frac(:,:,:) = 0._wp 
    404          h_ip     (:,:,:) = 0._wp 
     357 
     358         ! Melt ponds 
     359         WHERE( a_i > epsi10 ) 
     360            a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
     361         ELSEWHERE 
     362            a_ip_frac(:,:,:) = 0._wp 
     363         END WHERE 
     364         v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
     365           
     366         ! specific temperatures for coupled runs 
     367         tn_ice(:,:,:) = t_su(:,:,:) 
     368         t1_ice(:,:,:) = t_i (:,:,1,:) 
    405369         ! 
    406370      ENDIF ! ln_iceini 
    407371      ! 
    408       at_i (:,:) = 0.0_wp 
    409       DO jl = 1, jpl 
    410          at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 
    411       END DO 
    412       ! 
    413       ! --- set ice velocities --- ! 
    414       u_ice (:,:) = 0._wp 
    415       v_ice (:,:) = 0._wp 
    416       ! fields needed for ice_dyn_adv_umx 
    417       l_split_advumx(1) = .FALSE. 
     372      at_i(:,:) = SUM( a_i, dim=3 ) 
    418373      ! 
    419374      !---------------------------------------------- 
    420       ! 5) Snow-ice mass (case ice is fully embedded) 
     375      ! 3) Snow-ice mass (case ice is fully embedded) 
    421376      !---------------------------------------------- 
    422377      snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3  )   ! snow+ice mass 
    … …  
    470425       
    471426      !------------------------------------ 
    472       ! 6) store fields at before time-step 
     427      ! 4) store fields at before time-step 
    473428      !------------------------------------ 
    474429      ! it is only necessary for the 1st interpolation by Agrif 
    … …  
    508463      ! 
    509464      CHARACTER(len=256) ::  cn_dir          ! Root directory for location of ice files 
    510       TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi 
     465      TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_smi, sn_tmi, sn_tsu, sn_tms, sn_apd, sn_hpd 
    511466      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read 
    512467      ! 
    513       NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  & 
    514          &             rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, & 
    515          &             rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s,                             & 
    516          &             sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, cn_dir 
     468      NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, & 
     469         &             rn_hti_ini_n, rn_hti_ini_s, rn_hts_ini_n, rn_hts_ini_s, & 
     470         &             rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, & 
     471         &             rn_tmi_ini_n, rn_tmi_ini_s, rn_tsu_ini_n, rn_tsu_ini_s, rn_tms_ini_n, rn_tms_ini_s, & 
     472         &             rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, & 
     473         &             sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, sn_tms, sn_apd, sn_hpd, cn_dir 
    517474      !!----------------------------------------------------------------------------- 
    518475      ! 
    519476      REWIND( numnam_ice_ref )              ! Namelist namini in reference namelist : Ice initial state 
    520477      READ  ( numnam_ice_ref, namini, IOSTAT = ios, ERR = 901) 
    521 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namini in reference namelist', lwp ) 
     478901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namini in reference namelist' ) 
    522479      REWIND( numnam_ice_cfg )              ! Namelist namini in configuration namelist : Ice initial state 
    523480      READ  ( numnam_ice_cfg, namini, IOSTAT = ios, ERR = 902 ) 
    524 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namini in configuration namelist', lwp ) 
     481902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namini in configuration namelist' ) 
    525482      IF(lwm) WRITE ( numoni, namini ) 
    526483      ! 
    527484      slf_i(jp_hti) = sn_hti  ;  slf_i(jp_hts) = sn_hts 
    528       slf_i(jp_ati) = sn_ati  ;  slf_i(jp_tsu) = sn_tsu 
    529       slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_smi) = sn_smi 
     485      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_smi) = sn_smi 
     486      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_tsu) = sn_tsu   ;   slf_i(jp_tms) = sn_tms 
     487      slf_i(jp_apd) = sn_apd  ;  slf_i(jp_hpd) = sn_hpd 
    530488      ! 
    531489      IF(lwp) THEN                          ! control print 
    … …  
    534492         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    535493         WRITE(numout,*) '   Namelist namini:' 
    536          WRITE(numout,*) '      initialization with ice (T) or not (F)                 ln_iceini       = ', ln_iceini 
    537          WRITE(numout,*) '      ice initialization from a netcdf file                  ln_iceini_file  = ', ln_iceini_file 
    538          WRITE(numout,*) '      max delta ocean temp. above Tfreeze with initial ice   rn_thres_sst    = ', rn_thres_sst 
    539          WRITE(numout,*) '      initial snow thickness in the north                    rn_hts_ini_n    = ', rn_hts_ini_n 
    540          WRITE(numout,*) '      initial snow thickness in the south                    rn_hts_ini_s    = ', rn_hts_ini_s  
    541          WRITE(numout,*) '      initial ice thickness  in the north                    rn_hti_ini_n    = ', rn_hti_ini_n 
    542          WRITE(numout,*) '      initial ice thickness  in the south                    rn_hti_ini_s    = ', rn_hti_ini_s 
    543          WRITE(numout,*) '      initial ice concentr.  in the north                    rn_ati_ini_n    = ', rn_ati_ini_n 
    544          WRITE(numout,*) '      initial ice concentr.  in the north                    rn_ati_ini_s    = ', rn_ati_ini_s 
    545          WRITE(numout,*) '      initial  ice salinity  in the north                    rn_smi_ini_n    = ', rn_smi_ini_n 
    546          WRITE(numout,*) '      initial  ice salinity  in the south                    rn_smi_ini_s    = ', rn_smi_ini_s 
    547          WRITE(numout,*) '      initial  ice/snw temp  in the north                    rn_tmi_ini_n    = ', rn_tmi_ini_n 
    548          WRITE(numout,*) '      initial  ice/snw temp  in the south                    rn_tmi_ini_s    = ', rn_tmi_ini_s 
     494         WRITE(numout,*) '      ice initialization (T) or not (F)                ln_iceini      = ', ln_iceini 
     495         WRITE(numout,*) '      ice initialization from a netcdf file            ln_iceini_file = ', ln_iceini_file 
     496         WRITE(numout,*) '      max ocean temp. above Tfreeze with initial ice   rn_thres_sst   = ', rn_thres_sst 
     497         IF( ln_iceini .AND. .NOT.ln_iceini_file ) THEN 
     498            WRITE(numout,*) '      initial snw thickness in the north-south         rn_hts_ini     = ', rn_hts_ini_n,rn_hts_ini_s  
     499            WRITE(numout,*) '      initial ice thickness in the north-south         rn_hti_ini     = ', rn_hti_ini_n,rn_hti_ini_s 
     500            WRITE(numout,*) '      initial ice concentr  in the north-south         rn_ati_ini     = ', rn_ati_ini_n,rn_ati_ini_s 
     501            WRITE(numout,*) '      initial ice salinity  in the north-south         rn_smi_ini     = ', rn_smi_ini_n,rn_smi_ini_s 
     502            WRITE(numout,*) '      initial surf temperat in the north-south         rn_tsu_ini     = ', rn_tsu_ini_n,rn_tsu_ini_s 
     503            WRITE(numout,*) '      initial ice temperat  in the north-south         rn_tmi_ini     = ', rn_tmi_ini_n,rn_tmi_ini_s 
     504            WRITE(numout,*) '      initial snw temperat  in the north-south         rn_tms_ini     = ', rn_tms_ini_n,rn_tms_ini_s 
     505            WRITE(numout,*) '      initial pnd fraction  in the north-south         rn_apd_ini     = ', rn_apd_ini_n,rn_apd_ini_s 
     506            WRITE(numout,*) '      initial pnd depth     in the north-south         rn_hpd_ini     = ', rn_hpd_ini_n,rn_hpd_ini_s 
     507         ENDIF 
    549508      ENDIF 
    550509      ! 
    … …  
    554513         ALLOCATE( si(jpfldi), STAT=ierror ) 
    555514         IF( ierror > 0 ) THEN 
    556             CALL ctl_stop( 'Ice_ini in iceistate: unable to allocate si structure' )   ;   RETURN 
     515            CALL ctl_stop( 'ice_istate_ini in iceistate: unable to allocate si structure' )   ;   RETURN 
    557516         ENDIF 
    558517         ! 
    559518         DO ifpr = 1, jpfldi 
    560519            ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) ) 
    561             ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) ) 
     520            IF( slf_i(ifpr)%ln_tint )  ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) ) 
    562521         END DO 
    563522         ! 
    564523         ! fill si with slf_i and control print 
    565          CALL fld_fill( si, slf_i, cn_dir, 'ice_istate', 'ice istate ini', 'numnam_ice' ) 
    566          ! 
    567          CALL fld_read( nit000, 1, si )                ! input fields provided at the current time-step 
    568          ! 
     524         CALL fld_fill( si, slf_i, cn_dir, 'ice_istate_ini', 'initialization of sea ice fields', 'numnam_ice' ) 
     525         ! 
     526      ENDIF 
     527      ! 
     528      IF( .NOT.ln_pnd ) THEN 
     529         rn_apd_ini_n = 0. ; rn_apd_ini_s = 0. 
     530         rn_hpd_ini_n = 0. ; rn_hpd_ini_s = 0. 
     531         CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 when no ponds' ) 
    569532      ENDIF 
    570533      ! 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/iceitd.F90

    r10994 r11692  
    8888 
    8989      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
     90      IF( ln_icediachk )   CALL ice_cons2D  (0, 'iceitd_rem',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
    9091 
    9192      !----------------------------------------------------------------------------------------------- 
    … …  
    316317      ! 
    317318      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
     319      IF( ln_icediachk )   CALL ice_cons2D  (1, 'iceitd_rem',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
    318320      ! 
    319321   END SUBROUTINE ice_itd_rem 
    … …  
    586588      ! 
    587589      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
     590      IF( ln_icediachk )   CALL ice_cons2D  (0, 'iceitd_reb',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
    588591      ! 
    589592      jdonor(:,:) = 0 
    … …  
    664667      ! 
    665668      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
     669      IF( ln_icediachk )   CALL ice_cons2D  (1, 'iceitd_reb',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
    666670      ! 
    667671   END SUBROUTINE ice_itd_reb 
    … …  
    685689      REWIND( numnam_ice_ref )      ! Namelist namitd in reference namelist : Parameters for ice 
    686690      READ  ( numnam_ice_ref, namitd, IOSTAT = ios, ERR = 901) 
    687 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namitd in reference namelist', lwp ) 
     691901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namitd in reference namelist' ) 
    688692      REWIND( numnam_ice_cfg )      ! Namelist namitd in configuration namelist : Parameters for ice 
    689693      READ  ( numnam_ice_cfg, namitd, IOSTAT = ios, ERR = 902 ) 
    690 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namitd in configuration namelist', lwp ) 
     694902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namitd in configuration namelist' ) 
    691695      IF(lwm) WRITE( numoni, namitd ) 
    692696      ! 

  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/ICE/icerst.F90

    r10425 r11692  
    1414   !!   ice_rst_read  : read  restart file  
    1515   !!---------------------------------------------------------------------- 
    16    USE ice            ! sea-ice variables 
     16   USE ice            ! sea-ice: variables 
    1717   USE dom_oce        ! ocean domain 
     18   USE phycst  , ONLY : rt0 
    1819   USE sbc_oce , ONLY : nn_fsbc, ln_cpl 
    19    USE icectl 
     20   USE iceistate      ! sea-ice: initial state 
     21   USE icectl         ! sea-ice: control 
    2022   ! 
    2123   USE in_out_manager ! I/O manager 
    … …  
    5355      IF( kt == nit000 )   lrst_ice = .FALSE.   ! default definition 
    5456 
     57      IF( ln_rst_list .OR. nn_stock /= -1 ) THEN 
    5558      ! in order to get better performances with NetCDF format, we open and define the ice restart file  
    5659      ! one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), except if we write ice  
    5760      ! restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1 
    58       IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc    & 
     61      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nn_stock == nn_fsbc    & 
    5962         &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 
    6063         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
    … …  
    8184         ENDIF 
    8285      ENDIF 
     86      ENDIF 
    8387      ! 
    8488      IF( ln_icectl )   CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print 
    … …  
    118122 
    119123      ! Prognostic variables 
    120       CALL iom_rstput( iter, nitrst, numriw, 'v_i' , v_i  ) 
    121       CALL iom_rstput( iter, nitrst, numriw, 'v_s' , v_s  ) 
    122       CALL iom_rstput( iter, nitrst, numriw, 'sv_i', sv_i ) 
    123       CALL iom_rstput( iter, nitrst, numriw, 'oa_i', oa_i ) 
    124       CALL iom_rstput( iter, nitrst, numriw, 'a_i' , a_i  ) 
    125       CALL iom_rstput( iter, nitrst, numriw, 't_su', t_su ) 
    126       ! Melt ponds 
    127       CALL iom_rstput( iter, nitrst, numriw, 'a_ip', a_ip ) 
    128       CALL iom_rstput( iter, nitrst, numriw, 'v_ip', v_ip ) 
     124      CALL iom_rstput( iter, nitrst, numriw, 'v_i'  , v_i   ) 
     125      CALL iom_rstput( iter, nitrst, numriw, 'v_s'  , v_s   ) 
     126      CALL iom_rstput( iter, nitrst, numriw, 'sv_i' , sv_i  ) 
     127      CALL iom_rstput( iter, nitrst, numriw, 'a_i'  , a_i   ) 
     128      CALL iom_rstput( iter, nitrst, numriw, 't_su' , t_su  ) 
     129      CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice ) 
     130      CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice ) 
     131      CALL iom_rstput( iter, nitrst, numriw, 'oa_i' , oa_i  ) 
     132      CALL iom_rstput( iter, nitrst, numriw, 'a_ip' , a_ip  ) 
     133      CALL iom_rstput( iter, nitrst, numriw, 'v_ip' , v_ip  ) 
    129134      ! Snow enthalpy 
    130135      DO jk = 1, nlay_s  
    … …  
    141146         CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 
    142147      END DO 
    143       ! ice velocity 
    144       CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice ) ! u_ice 
    145       CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice ) ! v_ice 
    146148      ! fields needed for Met Office (Jules) coupling 
    147149      IF( ln_cpl ) THEN 
    … …  
    169171      INTEGER           ::   jk 
    170172      LOGICAL           ::   llok 
    171       INTEGER           ::   id1            ! local integer 
     173      INTEGER           ::   id0, id1, id2, id3, id4   ! local integer 
    172174      CHARACTER(len=25) ::   znam 
    173175      CHARACTER(len=2)  ::   zchar, zchar1 
    … …  
    184186      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kdlev = jpl ) 
    185187 
    186       CALL iom_get( numrir, 'nn_fsbc', zfice ) 
    187       CALL iom_get( numrir, 'kt_ice' , ziter )     
    188       IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter 
    189       IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1 
    190  
    191       ! Control of date 
    192       IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   & 
    193          &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart',  & 
    194          &                   '   verify the file or rerun with the value 0 for the',        & 
    195          &                   '   control of time parameter  nrstdt' ) 
    196       IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   & 
    197          &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart',  & 
    198          &                   '   verify the file or rerun with the value 0 for the',         & 
    199          &                   '   control of time parameter  nrstdt' ) 
    200  
    201       ! Prognostic variables  
    202       CALL iom_get( numrir, jpdom_autoglo, 'v_i' , v_i  ) 
    203       CALL iom_get( numrir, jpdom_autoglo, 'v_s' , v_s  ) 
    204       CALL iom_get( numrir, jpdom_autoglo, 'sv_i', sv_i ) 
    205       CALL iom_get( numrir, jpdom_autoglo, 'oa_i', oa_i ) 
    206       CALL iom_get( numrir, jpdom_autoglo, 'a_i' , a_i  ) 
    207       CALL iom_get( numrir, jpdom_autoglo, 't_su', t_su ) 
    208       ! Melt ponds 
    209       id1 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 
    210       IF( id1 > 0 ) THEN                       ! fields exist (melt ponds) 
    211          CALL iom_get( numrir, jpdom_autoglo, 'a_ip' , a_ip ) 
    212          CALL iom_get( numrir, jpdom_autoglo, 'v_ip' , v_ip ) 
    213       ELSE                                     ! start from rest 
    214          IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds output then set it to zero' 
    215          a_ip(:,:,:) = 0._wp 
    216          v_ip(:,:,:) = 0._wp 
    217       ENDIF 
    218       ! Snow enthalpy 
    219       DO jk = 1, nlay_s 
    220          WRITE(zchar1,'(I2.2)') jk 
    221          znam = 'e_s'//'_l'//zchar1 
    222          CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
    223          e_s(:,:,jk,:) = z3d(:,:,:) 
    224       END DO 
    225       ! Ice enthalpy 
    226       DO jk = 1, nlay_i 
    227          WRITE(zchar1,'(I2.2)') jk