Ignore:
Timestamp:
2019-09-19T11:18:03+02:00 (21 months ago)
Author:
jchanut
Message:

#2222, merged with trunk

Location:
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src
Files:
2 deleted
182 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/ice.F90

    r10882 r11573  
    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 
     
    334334 
    335335   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   at_ip      !: total melt pond fraction 
     336   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hm_ip      !: mean melt pond depth                     [m] 
    336337   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vt_ip      !: total melt pond volume per unit area     [m] 
    337338 
     
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icealb.F90

    r10535 r11573  
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icecor.F90

    r10994 r11573  
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icectl.F90

    r10994 r11573  
    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 values 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   = 1.e-5   ! kg/m2/s <=> 1mm of ice per year  spuriously gained/lost 
     49   REAL(wp), PARAMETER ::   zchk_s   = 1.e-4   ! g/m2/s  <=> 1mm of ice per year  spuriously gained/lost (considering s=10g/kg) 
     50   REAL(wp), PARAMETER ::   zchk_t   = 3.      ! W/m2    <=> 1mm of ice per year  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 
     70      !!              The thresholds (zchk_m, zchk_s, zchk_t) which determine violations are set to 
    6271      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 
    6372      !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
     
    6877      REAL(wp)        , INTENT(inout) ::   pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft 
    6978      !! 
    70       REAL(wp) ::   zv, zs, zt, zfs, zfv, zft 
    71       REAL(wp) ::   zvmin, zamin, zamax, zeimin, zesmin, zsmin 
     79      REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat, & 
     80         &          zdiag_vmin, zdiag_amin, zdiag_amax, zdiag_eimin, zdiag_esmin, zdiag_smin 
    7281      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 
     82      REAL(wp) ::   zarea 
    7583      !!------------------------------------------------------------------- 
    7684      ! 
    7785      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 
     86 
     87         pdiag_v = glob_sum( 'icectl',   SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) 
     88         pdiag_s = glob_sum( 'icectl',   SUM( sv_i * rhoi            , dim=3 ) * e1e2t ) 
     89         pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t ) 
     90 
     91         ! mass flux 
     92         pdiag_fv = glob_sum( 'icectl',  & 
     93            &                         ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 
     94            &                           wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t ) 
     95         ! salt flux 
     96         pdiag_fs = glob_sum( 'icectl',  & 
     97            &                         ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & 
     98            &                           sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) 
     99         ! heat flux 
     100         pdiag_ft = glob_sum( 'icectl',  & 
     101            &                         (   hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw  & 
     102            &                           - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) 
     103 
     104      ELSEIF( icount == 1 ) THEN 
     105 
     106         ! -- mass diag -- ! 
     107         zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_rdtice       & 
     108            &         + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn +       & 
     109            &                                 wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + & 
     110            &                                 wfx_ice_sub + wfx_spr ) * e1e2t )                                           & 
     111            &         - pdiag_fv 
    85112         ! 
    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  
     113         ! -- salt diag -- ! 
     114         zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_rdtice  & 
     115            &         + glob_sum( 'icectl', ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni +           & 
     116            &                                 sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) & 
     117            &         - pdiag_fs 
    91118         ! 
    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 
     119         ! -- heat diag -- ! 
     120         zdiag_heat = ( glob_sum( 'icectl', ( SUM(SUM(e_i, dim=4), dim=3) + SUM(SUM(e_s, dim=4), dim=3) ) * e1e2t ) - pdiag_t & 
     121            &         ) * r1_rdtice                                                                                           & 
     122            &         + glob_sum( 'icectl', (  hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw                      & 
     123            &                                - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t )                    & 
     124            &         - pdiag_ft 
     125 
     126         ! -- min/max diag -- ! 
     127         zdiag_amax  = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 
     128         zdiag_vmin  = glob_min( 'icectl', v_i ) 
     129         zdiag_amin  = glob_min( 'icectl', a_i ) 
     130         zdiag_smin  = glob_min( 'icectl', sv_i ) 
     131         zdiag_eimin = glob_min( 'icectl', SUM( e_i, dim=3 ) ) 
     132         zdiag_esmin = glob_min( 'icectl', SUM( e_s, dim=3 ) ) 
     133 
     134         ! -- advection scheme is conservative? -- ! 
     135         zvtrp = glob_sum( 'icectl', ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t ) ! must be close to 0 
     136         zetrp = glob_sum( 'icectl', ( diag_trp_ei        + diag_trp_es        ) * e1e2t ) ! must be close to 0 
     137 
     138         ! ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     139         zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 
     140 
     141         IF( lwp ) THEN 
    157142            ! 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 
     143            IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 
     144               &                   WRITE(numout,*)   cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice 
     145            IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 
     146               &                   WRITE(numout,*)   cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rdt_ice 
     147            IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) & 
     148               &                   WRITE(numout,*)   cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rdt_ice 
     149            ! check negative values 
     150            IF( zdiag_vmin  < 0. ) WRITE(numout,*)   cd_routine,' : violation v_i < 0         = ',zdiag_vmin 
     151            IF( zdiag_amin  < 0. ) WRITE(numout,*)   cd_routine,' : violation a_i < 0         = ',zdiag_amin 
     152            IF( zdiag_smin  < 0. ) WRITE(numout,*)   cd_routine,' : violation s_i < 0         = ',zdiag_smin 
     153            IF( zdiag_eimin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_i < 0         = ',zdiag_eimin 
     154            IF( zdiag_esmin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_s < 0         = ',zdiag_esmin 
    161155            ! 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 
     156            IF( zdiag_amax > MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 
     157               &                   WRITE(numout,*)   cd_routine,' : violation a_i > amax      = ',zdiag_amax 
     158            ! check if advection scheme is conservative 
     159            IF( ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
     160               &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rdt_ice 
    175161         ENDIF 
    176162         ! 
     
    179165   END SUBROUTINE ice_cons_hsm 
    180166 
    181  
    182167   SUBROUTINE ice_cons_final( cd_routine ) 
    183168      !!------------------------------------------------------------------- 
     
    188173      !! ** Method  : This is an online diagnostics which can be activated with ln_icediachk=true 
    189174      !!              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 
     175      !!              The thresholds (zchk_m, zchk_s, zchk_t) which determine the violation are set to 
    191176      !!              a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 
    192177      !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
    193178      !!              and a heat content of 3e5 J/kg (=latent heat of fusion)  
    194179      !!------------------------------------------------------------------- 
    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 
     180      CHARACTER(len=*), INTENT(in) ::   cd_routine    ! name of the routine 
     181      REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat 
     182      REAL(wp) ::   zarea 
    199183      !!------------------------------------------------------------------- 
    200184 
    201185      ! 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 
     186      ! -- mass diag -- ! 
     187      zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) 
     188 
     189      ! -- salt diag -- ! 
     190      zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice ) * e1e2t ) 
     191 
     192      ! -- heat diag -- ! 
    208193      ! 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 
     194      !!zdiag_heat  = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat + hfx_thd + hfx_dyn + hfx_res + hfx_sub + hfx_spr  & 
     195      !!   &                              ) * e1e2t ) 
     196 
     197      ! ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     198      zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 
     199 
     200      IF( lwp ) THEN 
     201         IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 
     202            &                   WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rdt_ice 
     203         IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 
     204            &                   WRITE(numout,*) cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rdt_ice 
     205         !!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,*) cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rdt_ice 
    222206      ENDIF 
    223207      ! 
    224208   END SUBROUTINE ice_cons_final 
    225209 
     210   SUBROUTINE ice_cons2D( icount, cd_routine, pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft ) 
     211      !!------------------------------------------------------------------- 
     212      !!                       ***  ROUTINE ice_cons2D *** 
     213      !! 
     214      !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine 
     215      !!                     + test if ice concentration and volume are > 0 
     216      !! 
     217      !! ** Method  : This is an online diagnostics which can be activated with ln_icediachk=true 
     218      !!              It stops the code if there is a violation of conservation at any gridcell 
     219      !!------------------------------------------------------------------- 
     220      INTEGER         , INTENT(in) ::   icount        ! called at: =0 the begining of the routine, =1  the end 
     221      CHARACTER(len=*), INTENT(in) ::   cd_routine    ! name of the routine 
     222      REAL(wp)        , DIMENSION(jpi,jpj), INTENT(inout) ::   pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft 
     223      !! 
     224      REAL(wp), DIMENSION(jpi,jpj) ::   zdiag_mass, zdiag_salt, zdiag_heat, & 
     225         &                              zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax   
     226      INTEGER ::   jl, jk 
     227      LOGICAL ::   ll_stop_m = .FALSE. 
     228      LOGICAL ::   ll_stop_s = .FALSE. 
     229      LOGICAL ::   ll_stop_t = .FALSE. 
     230      CHARACTER(len=120) ::   clnam   ! filename for the output 
     231      !!------------------------------------------------------------------- 
     232      ! 
     233      IF( icount == 0 ) THEN 
     234 
     235         pdiag_v = SUM( v_i  * rhoi + v_s * rhos, dim=3 ) 
     236         pdiag_s = SUM( sv_i * rhoi             , dim=3 ) 
     237         pdiag_t = SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) 
     238 
     239         ! mass flux 
     240         pdiag_fv = wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd  +  & 
     241            &       wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr 
     242         ! salt flux 
     243         pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam  
     244         ! heat flux 
     245         pdiag_ft =   hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw  &  
     246            &       - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr 
     247 
     248      ELSEIF( icount == 1 ) THEN 
     249 
     250         ! -- mass diag -- ! 
     251         zdiag_mass =   ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_rdtice                             & 
     252            &         + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 
     253            &             wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr )           & 
     254            &         - pdiag_fv 
     255         IF( MAXVAL( ABS(zdiag_mass) ) > zchk_m * rn_icechk_cel )   ll_stop_m = .TRUE. 
     256         ! 
     257         ! -- salt diag -- ! 
     258         zdiag_salt =   ( SUM( sv_i * rhoi , dim=3 ) - pdiag_s ) * r1_rdtice                                                  & 
     259            &         + ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) & 
     260            &         - pdiag_fs 
     261         IF( MAXVAL( ABS(zdiag_salt) ) > zchk_s * rn_icechk_cel )   ll_stop_s = .TRUE. 
     262         ! 
     263         ! -- heat diag -- ! 
     264         zdiag_heat =   ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_rdtice & 
     265            &         + (  hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw                                &  
     266            &            - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr )                                        & 
     267            &         - pdiag_ft 
     268         IF( MAXVAL( ABS(zdiag_heat) ) > zchk_t * rn_icechk_cel )   ll_stop_t = .TRUE. 
     269         ! 
     270         ! -- other diags -- ! 
     271         ! a_i < 0 
     272         zdiag_amin(:,:) = 0._wp 
     273         DO jl = 1, jpl 
     274            WHERE( a_i(:,:,jl) < 0._wp )   zdiag_amin(:,:) = 1._wp 
     275         ENDDO 
     276         ! v_i < 0 
     277         zdiag_vmin(:,:) = 0._wp 
     278         DO jl = 1, jpl 
     279            WHERE( v_i(:,:,jl) < 0._wp )   zdiag_vmin(:,:) = 1._wp 
     280         ENDDO 
     281         ! s_i < 0 
     282         zdiag_smin(:,:) = 0._wp 
     283         DO jl = 1, jpl 
     284            WHERE( s_i(:,:,jl) < 0._wp )   zdiag_smin(:,:) = 1._wp 
     285         ENDDO 
     286         ! e_i < 0 
     287         zdiag_emin(:,:) = 0._wp 
     288         DO jl = 1, jpl 
     289            DO jk = 1, nlay_i 
     290               WHERE( e_i(:,:,jk,jl) < 0._wp )   zdiag_emin(:,:) = 1._wp 
     291            ENDDO 
     292         ENDDO 
     293         ! a_i > amax 
     294         !WHERE( SUM( a_i, dim=3 ) > ( MAX( rn_amax_n, rn_amax_s ) + epsi10 )   ;   zdiag_amax(:,:) = 1._wp 
     295         !ELSEWHERE                                                             ;   zdiag_amax(:,:) = 0._wp 
     296         !END WHERE 
     297 
     298         IF( ll_stop_m .OR. ll_stop_s .OR. ll_stop_t ) THEN 
     299            clnam = 'diag_ice_conservation_'//cd_routine 
     300            CALL ice_cons_wri( clnam, zdiag_mass, zdiag_salt, zdiag_heat, zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin ) 
     301         ENDIF 
     302 
     303         IF( ll_stop_m )   CALL ctl_stop( 'STOP', cd_routine//': ice mass conservation issue' ) 
     304         IF( ll_stop_s )   CALL ctl_stop( 'STOP', cd_routine//': ice salt conservation issue' ) 
     305         IF( ll_stop_t )   CALL ctl_stop( 'STOP', cd_routine//': ice heat conservation issue' ) 
     306          
     307      ENDIF 
     308 
     309   END SUBROUTINE ice_cons2D 
     310 
     311   SUBROUTINE ice_cons_wri( cdfile_name, pdiag_mass, pdiag_salt, pdiag_heat, pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin ) 
     312      !!--------------------------------------------------------------------- 
     313      !!                 ***  ROUTINE ice_cons_wri  *** 
     314      !!         
     315      !! ** Purpose :   create a NetCDF file named cdfile_name which contains  
     316      !!                the instantaneous fields when conservation issue occurs 
     317      !! 
     318      !! ** Method  :   NetCDF files using ioipsl 
     319      !!---------------------------------------------------------------------- 
     320      CHARACTER(len=*), INTENT( in ) ::   cdfile_name      ! name of the file created 
     321      REAL(wp), DIMENSION(:,:), INTENT( in ) ::   pdiag_mass, pdiag_salt, pdiag_heat, & 
     322         &                                        pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax   
     323      !! 
     324      INTEGER ::   inum 
     325      !!---------------------------------------------------------------------- 
     326      !  
     327      IF(lwp) WRITE(numout,*) 
     328      IF(lwp) WRITE(numout,*) 'ice_cons_wri : single instantaneous ice state' 
     329      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~  named :', cdfile_name, '...nc' 
     330      IF(lwp) WRITE(numout,*)                 
     331 
     332      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 
     333       
     334      CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 )    ! ice mass spurious lost/gain 
     335      CALL iom_rstput( 0, 0, inum, 'cons_salt', pdiag_salt(:,:) , ktype = jp_r8 )    ! ice salt spurious lost/gain 
     336      CALL iom_rstput( 0, 0, inum, 'cons_heat', pdiag_heat(:,:) , ktype = jp_r8 )    ! ice heat spurious lost/gain 
     337      ! other diags 
     338      CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 )    !  
     339      CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 )    !  
     340      CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 )    !  
     341      CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 )    !  
     342       
     343      CALL iom_close( inum ) 
     344 
     345   END SUBROUTINE ice_cons_wri 
    226346    
    227347   SUBROUTINE ice_ctl( kt ) 
     
    246366      ialert_id = 2 ! reference number of this alert 
    247367      cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert 
    248  
    249368      DO jl = 1, jpl 
    250369         DO jj = 1, jpj 
    251370            DO ji = 1, jpi 
    252371               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) 
     372                  WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration ' 
    258373                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    259374               ENDIF 
     
    269384         DO ji = 1, jpi 
    270385            IF(   h_i(ji,jj,jl)  >  50._wp   ) THEN 
     386               WRITE(numout,*) ' ALERTE 3 :   Very thick ice' 
    271387               !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' ) 
    272388               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     
    280396      DO jj = 1, jpj 
    281397         DO ji = 1, jpi 
    282             IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 1.5  .AND.  & 
     398            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2.  .AND.  & 
    283399               &  at_i(ji,jj) > 0._wp   ) THEN 
     400               WRITE(numout,*) ' ALERTE 4 :   Very fast ice' 
    284401               !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,*)  
     402               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     403            ENDIF 
     404         END DO 
     405      END DO 
     406 
     407      ! Alert on salt flux 
     408      ialert_id = 5 ! reference number of this alert 
     409      cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert 
     410      DO jj = 1, jpj 
     411         DO ji = 1, jpi 
     412            IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth 
     413               WRITE(numout,*) ' ALERTE 5 :   High salt flux' 
     414               !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' ) 
    293415               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    294416            ENDIF 
     
    302424         DO ji = 1, jpi 
    303425            IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN  
     426               WRITE(numout,*) ' ALERTE 6 :   Ice on continents' 
    304427               !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                ! 
    314428               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    315429            ENDIF 
     
    325439            DO ji = 1, jpi 
    326440               IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     441                  WRITE(numout,*) ' ALERTE 7 :   Very fresh ice' 
    327442!                 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,*)  
    331443                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    332444               ENDIF 
     
    335447      END DO 
    336448! 
     449      ! Alert if qns very big 
     450      ialert_id = 8 ! reference number of this alert 
     451      cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert 
     452      DO jj = 1, jpj 
     453         DO ji = 1, jpi 
     454            IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 
     455               ! 
     456               WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux' 
     457               !CALL ice_prt( kt, ji, jj, 2, '   ') 
     458               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     459               ! 
     460            ENDIF 
     461         END DO 
     462      END DO 
     463      !+++++ 
    337464 
    338465!     ! Alert if too old ice 
     
    345472                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 
    346473                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN 
     474                  WRITE(numout,*) ' ALERTE 9 :   Wrong ice age' 
    347475                  !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ') 
    348476                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     
    351479         END DO 
    352480      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   
     481   
    393482      ! Alert if very warm ice 
    394483      ialert_id = 10 ! reference number of this alert 
     
    400489               DO ji = 1, jpi 
    401490                  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 
     491                  IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   & 
     492                     &                            .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN 
     493                     WRITE(numout,*) ' ALERTE 10 :   Very warm ice' 
     494                    inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    411495                  ENDIF 
    412496               END DO 
     
    435519   END SUBROUTINE ice_ctl 
    436520  
    437     
    438521   SUBROUTINE ice_prt( kt, ki, kj, kn, cd1 ) 
    439522      !!------------------------------------------------------------------- 
     
    443526      !!                in ocean.ouput  
    444527      !!                3 possibilities exist  
    445       !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1) 
     528      !!                n = 1/-1 -> simple ice state 
    446529      !!                n = 2    -> exhaustive state 
    447530      !!                n = 3    -> ice/ocean salt fluxes 
     
    482565               WRITE(numout,*) ' - Cell values ' 
    483566               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    484                WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj) 
    485567               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)        
     568               WRITE(numout,*) ' ato_i         : ', ato_i(ji,jj)        
    486569               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)        
    487570               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)        
     
    503586               END DO 
    504587            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              
    514588 
    515589            !-------------------- 
     
    525599               WRITE(numout,*) ' - Cell values ' 
    526600               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    527                WRITE(numout,*) ' cell area     : ', e1e2t(ji,jj) 
    528601               WRITE(numout,*) ' at_i          : ', at_i(ji,jj)        
    529602               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)        
     
    624697      !! 
    625698      !!------------------------------------------------------------------- 
    626       CHARACTER(len=*), INTENT(in)  :: cd_routine    ! name of the routine 
    627       INTEGER                       :: jk, jl        ! dummy loop indices 
     699      CHARACTER(len=*), INTENT(in) ::  cd_routine    ! name of the routine 
     700      INTEGER                      ::  jk, jl        ! dummy loop indices 
    628701       
    629702      CALL prt_ctl_info(' ========== ') 
     
    684757       
    685758   END SUBROUTINE ice_prt3D 
    686  
     759       
    687760#else 
    688761   !!---------------------------------------------------------------------- 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icedia.F90

    r10425 r11573  
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icedyn.F90

    r10994 r11573  
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icedyn_adv.F90

    r10911 r11573  
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icedyn_rdgrft.F90

    r10994 r11573  
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icedyn_rhg.F90

    r10911 r11573  
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icedyn_rhg_evp.F90

    r10891 r11573  
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/iceistate.F90

    r11229 r11573  
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/iceitd.F90

    r10994 r11573  
    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_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icerst.F90

    r10425 r11573  
    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 
    228          znam = 'e_i'//'_l'//zchar1 
    229          CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
    230          e_i(:,:,jk,:) = z3d(:,:,:) 
    231       END DO 
    232       ! ice velocity 
    233       CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice ) 
    234       CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice ) 
    235  
    236       CALL iom_delay_rst( 'READ', 'ICE', numrir )   ! read only ice delayed global communication variables 
    237  
    238       ! fields needed for Met Office (Jules) coupling 
    239       IF( ln_cpl ) THEN 
    240          CALL iom_get( numrir, jpdom_autoglo, 'cnd_ice', cnd_ice ) 
    241          CALL iom_get( numrir, jpdom_autoglo, 't1_ice' , t1_ice  ) 
     188      ! test if v_i exists  
     189      id0 = iom_varid( numrir, 'v_i' , ldstop = .FALSE. ) 
     190 
     191      !                    ! ------------------------------ ! 
     192      IF( id0 > 0 ) THEN   ! == case of a normal restart == ! 
     193         !                 ! ------------------------------ ! 
     194          
     195         ! Time info 
     196         CALL iom_get( numrir, 'nn_fsbc', zfice ) 
     197         CALL iom_get( numrir, 'kt_ice' , ziter )     
     198         IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter 
     199         IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1 
     200 
     201         ! Control of date 
     202         IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   & 
     203            &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart',  & 
     204            &                   '   verify the file or rerun with the value 0 for the',        & 
     205            &                   '   control of time parameter  nrstdt' ) 
     206         IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   & 
     207            &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart',  & 
     208            &                   '   verify the file or rerun with the value 0 for the',         & 
     209            &                   '   control of time parameter  nrstdt' ) 
     210 
     211         ! --- mandatory fields --- !  
     212         CALL iom_get( numrir, jpdom_autoglo, 'v_i'  , v_i   ) 
     213         CALL iom_get( numrir, jpdom_autoglo, 'v_s'  , v_s   ) 
     214         CALL iom_get( numrir, jpdom_autoglo, 'sv_i' , sv_i  ) 
     215         CALL iom_get( numrir, jpdom_autoglo, 'a_i'  , a_i   ) 
     216         CALL iom_get( numrir, jpdom_autoglo, 't_su' , t_su  ) 
     217         CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice ) 
     218         CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice ) 
     219         ! Snow enthalpy 
     220         DO jk = 1, nlay_s 
     221            WRITE(zchar1,'(I2.2)') jk 
     222            znam = 'e_s'//'_l'//zchar1 
     223            CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     224            e_s(:,:,jk,:) = z3d(:,:,:) 
     225         END DO 
     226         ! Ice enthalpy 
     227         DO jk = 1, nlay_i 
     228            WRITE(zchar1,'(I2.2)') jk 
     229            znam = 'e_i'//'_l'//zchar1 
     230            CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     231            e_i(:,:,jk,:) = z3d(:,:,:) 
     232         END DO 
     233         ! -- optional fields -- ! 
     234         ! ice age 
     235         id1 = iom_varid( numrir, 'oa_i' , ldstop = .FALSE. ) 
     236         IF( id1 > 0 ) THEN                       ! fields exist 
     237            CALL iom_get( numrir, jpdom_autoglo, 'oa_i', oa_i ) 
     238         ELSE                                     ! start from rest 
     239            IF(lwp) WRITE(numout,*) '   ==>>   previous run without ice age output then set it to zero' 
     240            oa_i(:,:,:) = 0._wp 
     241         ENDIF 
     242         ! melt ponds 
     243         id2 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 
     244         IF( id2 > 0 ) THEN                       ! fields exist 
     245            CALL iom_get( numrir, jpdom_autoglo, 'a_ip' , a_ip ) 
     246            CALL iom_get( numrir, jpdom_autoglo, 'v_ip' , v_ip ) 
     247         ELSE                                     ! start from rest 
     248            IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds output then set it to zero' 
     249            a_ip(:,:,:) = 0._wp 
     250            v_ip(:,:,:) = 0._wp 
     251         ENDIF 
     252         ! fields needed for Met Office (Jules) coupling 
     253         IF( ln_cpl ) THEN 
     254            id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 
     255            id4 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
     256            IF( id3 > 0 .AND. id4 > 0 ) THEN         ! fields exist 
     257               CALL iom_get( numrir, jpdom_autoglo, 'cnd_ice', cnd_ice ) 
     258               CALL iom_get( numrir, jpdom_autoglo, 't1_ice' , t1_ice  ) 
     259            ELSE                                     ! start from rest 
     260               IF(lwp) WRITE(numout,*) '   ==>>   previous run without conductivity output then set it to zero' 
     261               cnd_ice(:,:,:) = 0._wp 
     262               t1_ice (:,:,:) = rt0 
     263            ENDIF 
     264         ENDIF 
     265 
     266         CALL iom_delay_rst( 'READ', 'ICE', numrir )   ! read only ice delayed global communication variables 
     267 
     268         !                 ! ---------------------------------- ! 
     269      ELSE                 ! == case of a simplified restart == ! 
     270         !                 ! ---------------------------------- ! 
     271         CALL ctl_warn('ice_rst_read: you are using a simplified ice restart') 
     272         ! 
     273         CALL ice_istate_init 
     274         CALL ice_istate( nit000 ) 
     275         ! 
     276         IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) & 
     277            &   CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T') 
     278         ! 
    242279      ENDIF 
    243280 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icesbc.F90

    r10535 r11573  
    114114      INTEGER, INTENT(in) ::   ksbc   ! flux formulation (user defined, bulk or Pure Coupled) 
    115115      ! 
    116       INTEGER  ::   ji, jj, jl                                ! dummy loop index 
    117       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    118       REAL(wp), DIMENSION(jpi,jpj)     ::   zalb              ! 2D workspace 
     116      INTEGER  ::   ji, jj, jl      ! dummy loop index 
     117      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios  
     118      REAL(wp), DIMENSION(jpi,jpj,jpl)              ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
     119      REAL(wp), DIMENSION(:,:)        , ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
    119120      !!-------------------------------------------------------------------- 
    120121      ! 
     
    126127         WRITE(numout,*)'~~~~~~~~~~~~~~~' 
    127128      ENDIF 
     129 
     130      ! get missing value from xml 
     131      CALL iom_miss_val( "icetemp", zmiss_val ) 
    128132 
    129133      ! --- cloud-sky and overcast-sky ice albedos --- ! 
     
    152156 
    153157      !--- output ice albedo and surface albedo ---! 
    154       IF( iom_use('icealb') ) THEN 
    155          WHERE( at_i_b <= epsi06 )   ;   zalb(:,:) = rn_alb_oce 
    156          ELSEWHERE                   ;   zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
     158      IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN 
     159 
     160         ALLOCATE( zalb(jpi,jpj), zmsk00(jpi,jpj) ) 
     161 
     162         WHERE( at_i_b <= epsi06 ) 
     163            zmsk00(:,:) = 0._wp 
     164            zalb  (:,:) = rn_alb_oce 
     165         ELSEWHERE 
     166            zmsk00(:,:) = 1._wp             
     167            zalb  (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
    157168         END WHERE 
    158          CALL iom_put( "icealb" , zalb(:,:) ) 
    159       ENDIF 
    160       IF( iom_use('albedo') ) THEN 
     169         ! ice albedo 
     170         CALL iom_put( 'icealb' , zalb * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) 
     171         ! ice+ocean albedo 
    161172         zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b ) 
    162          CALL iom_put( "albedo" , zalb(:,:) ) 
     173         CALL iom_put( 'albedo' , zalb ) 
     174 
     175         DEALLOCATE( zalb, zmsk00 ) 
     176 
    163177      ENDIF 
    164178      ! 
     
    272286      REWIND( numnam_ice_ref )         ! Namelist namsbc in reference namelist : Ice dynamics 
    273287      READ  ( numnam_ice_ref, namsbc, IOSTAT = ios, ERR = 901) 
    274 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp ) 
     288901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist' ) 
    275289      REWIND( numnam_ice_cfg )         ! Namelist namsbc in configuration namelist : Ice dynamics 
    276290      READ  ( numnam_ice_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 
    277 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp ) 
     291902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist' ) 
    278292      IF(lwm) WRITE( numoni, namsbc ) 
    279293      ! 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icestp.F90

    r10994 r11573  
    254254      IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst 
    255255         CALL ice_istate_init 
    256          CALL ice_istate 
     256         CALL ice_istate( nit000 ) 
    257257      ELSE                                    ! start from a restart file 
    258258         CALL ice_rst_read 
     
    303303      REWIND( numnam_ice_ref )      ! Namelist nampar in reference namelist : Parameters for ice 
    304304      READ  ( numnam_ice_ref, nampar, IOSTAT = ios, ERR = 901) 
    305 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampar in reference namelist', lwp ) 
     305901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampar in reference namelist' ) 
    306306      REWIND( numnam_ice_cfg )      ! Namelist nampar in configuration namelist : Parameters for ice 
    307307      READ  ( numnam_ice_cfg, nampar, IOSTAT = ios, ERR = 902 ) 
    308 902   IF( ios > 0 )   CALL ctl_nam ( ios , 'nampar in configuration namelist', lwp ) 
     308902   IF( ios > 0 )   CALL ctl_nam ( ios , 'nampar in configuration namelist' ) 
    309309      IF(lwm) WRITE( numoni, nampar ) 
    310310      ! 
     
    425425      wfx_err_sub(:,:) = 0._wp 
    426426      ! 
    427       afx_tot(:,:) = 0._wp   ; 
    428       ! 
    429427      diag_heat(:,:) = 0._wp ;   diag_sice(:,:) = 0._wp 
    430428      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icethd.F90

    r10994 r11573  
    9595      IF( ln_timing    )   CALL timing_start('icethd')                                                             ! timing 
    9696      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
     97      IF( ln_icediachk )   CALL ice_cons2D  (0, 'icethd',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    9798 
    9899      IF( kt == nit000 .AND. lwp ) THEN 
     
    243244      ! 
    244245      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
     246      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icethd',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
    245247      !                    
    246248      IF( jpl > 1  )          CALL ice_itd_rem( kt )                ! --- Transport ice between thickness categories --- ! 
     
    539541      REWIND( numnam_ice_ref )              ! Namelist namthd in reference namelist : Ice thermodynamics 
    540542      READ  ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901) 
    541 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd in reference namelist', lwp ) 
     543901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd in reference namelist' ) 
    542544      REWIND( numnam_ice_cfg )              ! Namelist namthd in configuration namelist : Ice thermodynamics 
    543545      READ  ( numnam_ice_cfg, namthd, IOSTAT = ios, ERR = 902 ) 
    544 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd in configuration namelist', lwp ) 
     546902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd in configuration namelist' ) 
    545547      IF(lwm) WRITE( numoni, namthd ) 
    546548      ! 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icethd_da.F90

    r10069 r11573  
    179179      REWIND( numnam_ice_ref )              ! Namelist namthd_da in reference namelist : Ice thermodynamics 
    180180      READ  ( numnam_ice_ref, namthd_da, IOSTAT = ios, ERR = 901) 
    181 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_da in reference namelist', lwp ) 
     181901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_da in reference namelist' ) 
    182182      REWIND( numnam_ice_cfg )              ! Namelist namthd_da in configuration namelist : Ice thermodynamics 
    183183      READ  ( numnam_ice_cfg, namthd_da, IOSTAT = ios, ERR = 902 ) 
    184 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_da in configuration namelist', lwp ) 
     184902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_da in configuration namelist' ) 
    185185      IF(lwm) WRITE( numoni, namthd_da ) 
    186186      ! 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icethd_do.F90

    r11229 r11573  
    113113 
    114114      IF( ln_icediachk )   CALL ice_cons_hsm( 0, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft ) 
     115      IF( ln_icediachk )   CALL ice_cons2D  ( 0, 'icethd_do',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft ) 
    115116 
    116117      at_i(:,:) = SUM( a_i, dim=3 ) 
     
    420421      ! 
    421422      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
     423      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icethd_do',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
    422424      ! 
    423425   END SUBROUTINE ice_thd_do 
     
    443445      REWIND( numnam_ice_ref )              ! Namelist namthd_do in reference namelist : Ice thermodynamics 
    444446      READ  ( numnam_ice_ref, namthd_do, IOSTAT = ios, ERR = 901) 
    445 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_do in reference namelist', lwp ) 
     447901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_do in reference namelist' ) 
    446448      REWIND( numnam_ice_cfg )              ! Namelist namthd_do in configuration namelist : Ice thermodynamics 
    447449      READ  ( numnam_ice_cfg, namthd_do, IOSTAT = ios, ERR = 902 ) 
    448 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_do in configuration namelist', lwp ) 
     450902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_do in configuration namelist' ) 
    449451      IF(lwm) WRITE( numoni, namthd_do ) 
    450452      ! 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icethd_pnd.F90

    r10532 r11573  
    205205      INTEGER  ::   ios, ioptio   ! Local integer 
    206206      !! 
    207       NAMELIST/namthd_pnd/  ln_pnd_H12, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb 
     207      NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_H12, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb 
    208208      !!------------------------------------------------------------------- 
    209209      ! 
    210210      REWIND( numnam_ice_ref )              ! Namelist namthd_pnd  in reference namelist : Melt Ponds   
    211211      READ  ( numnam_ice_ref, namthd_pnd, IOSTAT = ios, ERR = 901) 
    212 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_pnd  in reference namelist', lwp ) 
     212901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_pnd  in reference namelist' ) 
    213213      REWIND( numnam_ice_cfg )              ! Namelist namthd_pnd  in configuration namelist : Melt Ponds 
    214214      READ  ( numnam_ice_cfg, namthd_pnd, IOSTAT = ios, ERR = 902 ) 
    215 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist', lwp ) 
     215902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist' ) 
    216216      IF(lwm) WRITE ( numoni, namthd_pnd ) 
    217217      ! 
     
    221221         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    222222         WRITE(numout,*) '   Namelist namicethd_pnd:' 
    223          WRITE(numout,*) '      Evolutive  melt pond fraction and depth (Holland et al 2012) ln_pnd_H12 = ', ln_pnd_H12 
    224          WRITE(numout,*) '      Prescribed melt pond fraction and depth                      ln_pnd_CST = ', ln_pnd_CST 
    225          WRITE(numout,*) '         Prescribed pond fraction                                  rn_apnd    = ', rn_apnd 
    226          WRITE(numout,*) '         Prescribed pond depth                                     rn_hpnd    = ', rn_hpnd 
    227          WRITE(numout,*) '      Melt ponds affect albedo or not                              ln_pnd_alb = ', ln_pnd_alb 
     223         WRITE(numout,*) '      Melt ponds activated or not                                     ln_pnd     = ', ln_pnd 
     224         WRITE(numout,*) '         Evolutive  melt pond fraction and depth (Holland et al 2012) ln_pnd_H12 = ', ln_pnd_H12 
     225         WRITE(numout,*) '         Prescribed melt pond fraction and depth                      ln_pnd_CST = ', ln_pnd_CST 
     226         WRITE(numout,*) '            Prescribed pond fraction                                  rn_apnd    = ', rn_apnd 
     227         WRITE(numout,*) '            Prescribed pond depth                                     rn_hpnd    = ', rn_hpnd 
     228         WRITE(numout,*) '         Melt ponds affect albedo or not                              ln_pnd_alb = ', ln_pnd_alb 
    228229      ENDIF 
    229230      ! 
    230231      !                             !== set the choice of ice pond scheme ==! 
    231232      ioptio = 0 
    232                                                             nice_pnd = np_pndNO 
    233       IF( ln_pnd_CST ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndCST    ;   ENDIF 
    234       IF( ln_pnd_H12 ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndH12    ;   ENDIF 
    235       IF( ioptio > 1 )   CALL ctl_stop( 'ice_thd_pnd_init: choose one and only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' ) 
     233      IF( .NOT.ln_pnd ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndNO     ;   ENDIF 
     234      IF( ln_pnd_CST  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndCST    ;   ENDIF 
     235      IF( ln_pnd_H12  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndH12    ;   ENDIF 
     236      IF( ioptio /= 1 )   & 
     237         & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' ) 
    236238      ! 
    237239      SELECT CASE( nice_pnd ) 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icethd_sal.F90

    r10069 r11573  
    134134      REWIND( numnam_ice_ref )              ! Namelist namthd_sal in reference namelist : Ice salinity 
    135135      READ  ( numnam_ice_ref, namthd_sal, IOSTAT = ios, ERR = 901) 
    136 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_sal in reference namelist', lwp ) 
     136901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_sal in reference namelist' ) 
    137137      REWIND( numnam_ice_cfg )              ! Namelist namthd_sal in configuration namelist : Ice salinity 
    138138      READ  ( numnam_ice_cfg, namthd_sal, IOSTAT = ios, ERR = 902 ) 
    139 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_sal in configuration namelist', lwp ) 
     139902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_sal in configuration namelist' ) 
    140140      IF(lwm) WRITE ( numoni, namthd_sal ) 
    141141      ! 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icethd_zdf.F90

    r10534 r11573  
    9090      REWIND( numnam_ice_ref )              ! Namelist namthd_zdf in reference namelist : Ice thermodynamics 
    9191      READ  ( numnam_ice_ref, namthd_zdf, IOSTAT = ios, ERR = 901) 
    92 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_zdf in reference namelist', lwp ) 
     92901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_zdf in reference namelist' ) 
    9393      REWIND( numnam_ice_cfg )              ! Namelist namthd_zdf in configuration namelist : Ice thermodynamics 
    9494      READ  ( numnam_ice_cfg, namthd_zdf, IOSTAT = ios, ERR = 902 ) 
    95 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist', lwp ) 
     95902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_zdf in configuration namelist' ) 
    9696      IF(lwm) WRITE( numoni, namthd_zdf ) 
    9797      ! 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/iceupdate.F90

    r10425 r11573  
    198198      ! --- salt fluxes [kg/m2/s] --- ! 
    199199      !                           ! sfxice =  sfxbog + sfxbom + sfxsum + sfxsni + sfxopw + sfxres + sfxdyn + sfxbri + sfxsub + sfxlam 
    200       IF( iom_use('sfxice'  ) )   CALL iom_put( "sfxice", sfx     * 1.e-03 )   ! salt flux from total ice growth/melt 
    201       IF( iom_use('sfxbog'  ) )   CALL iom_put( "sfxbog", sfx_bog * 1.e-03 )   ! salt flux from bottom growth 
    202       IF( iom_use('sfxbom'  ) )   CALL iom_put( "sfxbom", sfx_bom * 1.e-03 )   ! salt flux from bottom melting 
    203       IF( iom_use('sfxsum'  ) )   CALL iom_put( "sfxsum", sfx_sum * 1.e-03 )   ! salt flux from surface melting 
    204       IF( iom_use('sfxlam'  ) )   CALL iom_put( "sfxlam", sfx_lam * 1.e-03 )   ! salt flux from lateral melting 
    205       IF( iom_use('sfxsni'  ) )   CALL iom_put( "sfxsni", sfx_sni * 1.e-03 )   ! salt flux from snow ice formation 
    206       IF( iom_use('sfxopw'  ) )   CALL iom_put( "sfxopw", sfx_opw * 1.e-03 )   ! salt flux from open water formation 
    207       IF( iom_use('sfxdyn'  ) )   CALL iom_put( "sfxdyn", sfx_dyn * 1.e-03 )   ! salt flux from ridging rafting 
    208       IF( iom_use('sfxbri'  ) )   CALL iom_put( "sfxbri", sfx_bri * 1.e-03 )   ! salt flux from brines 
    209       IF( iom_use('sfxres'  ) )   CALL iom_put( "sfxres", sfx_res * 1.e-03 )   ! salt flux from undiagnosed processes 
    210       IF( iom_use('sfxsub'  ) )   CALL iom_put( "sfxsub", sfx_sub * 1.e-03 )   ! salt flux from sublimation 
     200      IF( iom_use('sfxice'  ) )   CALL iom_put( 'sfxice', sfx     * 1.e-03 )   ! salt flux from total ice growth/melt 
     201      IF( iom_use('sfxbog'  ) )   CALL iom_put( 'sfxbog', sfx_bog * 1.e-03 )   ! salt flux from bottom growth 
     202      IF( iom_use('sfxbom'  ) )   CALL iom_put( 'sfxbom', sfx_bom * 1.e-03 )   ! salt flux from bottom melting 
     203      IF( iom_use('sfxsum'  ) )   CALL iom_put( 'sfxsum', sfx_sum * 1.e-03 )   ! salt flux from surface melting 
     204      IF( iom_use('sfxlam'  ) )   CALL iom_put( 'sfxlam', sfx_lam * 1.e-03 )   ! salt flux from lateral melting 
     205      IF( iom_use('sfxsni'  ) )   CALL iom_put( 'sfxsni', sfx_sni * 1.e-03 )   ! salt flux from snow ice formation 
     206      IF( iom_use('sfxopw'  ) )   CALL iom_put( 'sfxopw', sfx_opw * 1.e-03 )   ! salt flux from open water formation 
     207      IF( iom_use('sfxdyn'  ) )   CALL iom_put( 'sfxdyn', sfx_dyn * 1.e-03 )   ! salt flux from ridging rafting 
     208      IF( iom_use('sfxbri'  ) )   CALL iom_put( 'sfxbri', sfx_bri * 1.e-03 )   ! salt flux from brines 
     209      IF( iom_use('sfxres'  ) )   CALL iom_put( 'sfxres', sfx_res * 1.e-03 )   ! salt flux from undiagnosed processes 
     210      IF( iom_use('sfxsub'  ) )   CALL iom_put( 'sfxsub', sfx_sub * 1.e-03 )   ! salt flux from sublimation 
    211211 
    212212      ! --- mass fluxes [kg/m2/s] --- ! 
    213       IF( iom_use('emp_oce' ) )   CALL iom_put( "emp_oce", emp_oce )   ! emp over ocean (taking into account the snow blown away from the ice) 
    214       IF( iom_use('emp_ice' ) )   CALL iom_put( "emp_ice", emp_ice )   ! emp over ice   (taking into account the snow blown away from the ice) 
     213      CALL iom_put( 'emp_oce', emp_oce )   ! emp over ocean (taking into account the snow blown away from the ice) 
     214      CALL iom_put( 'emp_ice', emp_ice )   ! emp over ice   (taking into account the snow blown away from the ice) 
    215215 
    216216      !                           ! vfxice = vfxbog + vfxbom + vfxsum + vfxsni + vfxopw + vfxdyn + vfxres + vfxlam + vfxpnd 
    217       IF( iom_use('vfxice'  ) )   CALL iom_put( "vfxice" , wfx_ice )   ! mass flux from total ice growth/melt 
    218       IF( iom_use('vfxbog'  ) )   CALL iom_put( "vfxbog" , wfx_bog )   ! mass flux from bottom growth 
    219       IF( iom_use('vfxbom'  ) )   CALL iom_put( "vfxbom" , wfx_bom )   ! mass flux from bottom melt  
    220       IF( iom_use('vfxsum'  ) )   CALL iom_put( "vfxsum" , wfx_sum )   ! mass flux from surface melt  
    221       IF( iom_use('vfxlam'  ) )   CALL iom_put( "vfxlam" , wfx_lam )   ! mass flux from lateral melt  
    222       IF( iom_use('vfxsni'  ) )   CALL iom_put( "vfxsni" , wfx_sni )   ! mass flux from snow-ice formation 
    223       IF( iom_use('vfxopw'  ) )   CALL iom_put( "vfxopw" , wfx_opw )   ! mass flux from growth in open water 
    224       IF( iom_use('vfxdyn'  ) )   CALL iom_put( "vfxdyn" , wfx_dyn )   ! mass flux from dynamics (ridging) 
    225       IF( iom_use('vfxres'  ) )   CALL iom_put( "vfxres" , wfx_res )   ! mass flux from undiagnosed processes  
    226       IF( iom_use('vfxpnd'  ) )   CALL iom_put( "vfxpnd" , wfx_pnd )   ! mass flux from melt ponds 
    227       IF( iom_use('vfxsub'  ) )   CALL iom_put( "vfxsub" , wfx_ice_sub )   ! mass flux from ice sublimation (ice-atm.) 
    228       IF( iom_use('vfxsub_err') ) CALL iom_put( "vfxsub_err", wfx_err_sub )   ! "excess" of sublimation sent to ocean       
    229  
    230       IF ( iom_use( "vfxthin" ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations   
     217      CALL iom_put( 'vfxice'    , wfx_ice    )   ! mass flux from total ice growth/melt 
     218      CALL iom_put( 'vfxbog'    , wfx_bog    )   ! mass flux from bottom growth 
     219      CALL iom_put( 'vfxbom'    , wfx_bom    )   ! mass flux from bottom melt  
     220      CALL iom_put( 'vfxsum'    , wfx_sum    )   ! mass flux from surface melt  
     221      CALL iom_put( 'vfxlam'    , wfx_lam    )   ! mass flux from lateral melt  
     222      CALL iom_put( 'vfxsni'    , wfx_sni    )   ! mass flux from snow-ice formation 
     223      CALL iom_put( 'vfxopw'    , wfx_opw    )   ! mass flux from growth in open water 
     224      CALL iom_put( 'vfxdyn'    , wfx_dyn    )   ! mass flux from dynamics (ridging) 
     225      CALL iom_put( 'vfxres'    , wfx_res    )   ! mass flux from undiagnosed processes  
     226      CALL iom_put( 'vfxpnd'    , wfx_pnd    )   ! mass flux from melt ponds 
     227      CALL iom_put( 'vfxsub'    , wfx_ice_sub )   ! mass flux from ice sublimation (ice-atm.) 
     228      CALL iom_put( 'vfxsub_err', wfx_err_sub )   ! "excess" of sublimation sent to ocean       
     229 
     230      IF ( iom_use( 'vfxthin' ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations   
    231231         WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog 
    232232         ELSEWHERE                                     ; z2d = 0._wp 
    233233         END WHERE 
    234          CALL iom_put( "vfxthin", wfx_opw + z2d ) 
    235       ENDIF 
    236  
    237       !                              ! vfxsnw = vfxsnw_sni + vfxsnw_dyn + vfxsnw_sum 
    238       IF( iom_use('vfxsnw'     ) )   CALL iom_put( "vfxsnw"     , wfx_snw     )   ! mass flux from total snow growth/melt 
    239       IF( iom_use('vfxsnw_sum' ) )   CALL iom_put( "vfxsnw_sum" , wfx_snw_sum )   ! mass flux from snow melt at the surface 
    240       IF( iom_use('vfxsnw_sni' ) )   CALL iom_put( "vfxsnw_sni" , wfx_snw_sni )   ! mass flux from snow melt during snow-ice formation  
    241       IF( iom_use('vfxsnw_dyn' ) )   CALL iom_put( "vfxsnw_dyn" , wfx_snw_dyn )   ! mass flux from dynamics (ridging)  
    242       IF( iom_use('vfxsnw_sub' ) )   CALL iom_put( "vfxsnw_sub" , wfx_snw_sub )   ! mass flux from snow sublimation (ice-atm.)  
    243       IF( iom_use('vfxsnw_pre' ) )   CALL iom_put( "vfxsnw_pre" , wfx_spr     )   ! snow precip 
     234         CALL iom_put( 'vfxthin', wfx_opw + z2d ) 
     235      ENDIF 
     236 
     237      !                            ! vfxsnw = vfxsnw_sni + vfxsnw_dyn + vfxsnw_sum 
     238      CALL iom_put( 'vfxsnw'     , wfx_snw     )   ! mass flux from total snow growth/melt 
     239      CALL iom_put( 'vfxsnw_sum' , wfx_snw_sum )   ! mass flux from snow melt at the surface 
     240      CALL iom_put( 'vfxsnw_sni' , wfx_snw_sni )   ! mass flux from snow melt during snow-ice formation  
     241      CALL iom_put( 'vfxsnw_dyn' , wfx_snw_dyn )   ! mass flux from dynamics (ridging)  
     242      CALL iom_put( 'vfxsnw_sub' , wfx_snw_sub )   ! mass flux from snow sublimation (ice-atm.)  
     243      CALL iom_put( 'vfxsnw_pre' , wfx_spr     )   ! snow precip 
    244244 
    245245      ! --- heat fluxes [W/m2] --- ! 
    246246      !                              ! qt_atm_oi - qt_oce_ai = hfxdhc - ( dihctrp + dshctrp ) 
    247       IF( iom_use('qsr_oce'    ) )   CALL iom_put( "qsr_oce"    , qsr_oce * ( 1._wp - at_i_b )                               )   !     solar flux at ocean surface 
    248       IF( iom_use('qns_oce'    ) )   CALL iom_put( "qns_oce"    , qns_oce * ( 1._wp - at_i_b ) + qemp_oce                    )   ! non-solar flux at ocean surface 
    249       IF( iom_use('qsr_ice'    ) )   CALL iom_put( "qsr_ice"    , SUM( qsr_ice * a_i_b, dim=3 )                              )   !     solar flux at ice surface 
    250       IF( iom_use('qns_ice'    ) )   CALL iom_put( "qns_ice"    , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice                   )   ! non-solar flux at ice surface 
    251       IF( iom_use('qtr_ice_bot') )   CALL iom_put( "qtr_ice_bot", SUM( qtr_ice_bot * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice 
    252       IF( iom_use('qtr_ice_top') )   CALL iom_put( "qtr_ice_top", SUM( qtr_ice_top * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice surface 
    253       IF( iom_use('qt_oce'     ) )   CALL iom_put( "qt_oce"     ,      ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) 
    254       IF( iom_use('qt_ice'     ) )   CALL iom_put( "qt_ice"     , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 )     + qemp_ice ) 
    255       IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( "qt_oce_ai"  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm)  
    256       IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( "qt_atm_oi"  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce)  
    257       IF( iom_use('qemp_oce'   ) )   CALL iom_put( "qemp_oce"   , qemp_oce                                                   )   ! Downward Heat Flux from E-P over ocean 
    258       IF( iom_use('qemp_ice'   ) )   CALL iom_put( "qemp_ice"   , qemp_ice                                                   )   ! Downward Heat Flux from E-P over ice 
     247      IF( iom_use('qsr_oce'    ) )   CALL iom_put( 'qsr_oce'    , qsr_oce * ( 1._wp - at_i_b )                               )   !     solar flux at ocean surface 
     248      IF( iom_use('qns_oce'    ) )   CALL iom_put( 'qns_oce'    , qns_oce * ( 1._wp - at_i_b ) + qemp_oce                    )   ! non-solar flux at ocean surface 
     249      IF( iom_use('qsr_ice'    ) )   CALL iom_put( 'qsr_ice'    , SUM( qsr_ice * a_i_b, dim=3 )                              )   !     solar flux at ice surface 
     250      IF( iom_use('qns_ice'    ) )   CALL iom_put( 'qns_ice'    , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice                   )   ! non-solar flux at ice surface 
     251      IF( iom_use('qtr_ice_bot') )   CALL iom_put( 'qtr_ice_bot', SUM( qtr_ice_bot * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice 
     252      IF( iom_use('qtr_ice_top') )   CALL iom_put( 'qtr_ice_top', SUM( qtr_ice_top * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice surface 
     253      IF( iom_use('qt_oce'     ) )   CALL iom_put( 'qt_oce'     ,      ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) 
     254      IF( iom_use('qt_ice'     ) )   CALL iom_put( 'qt_ice'     , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 )     + qemp_ice ) 
     255      IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( 'qt_oce_ai'  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm)  
     256      IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( 'qt_atm_oi'  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce)  
     257      IF( iom_use('qemp_oce'   ) )   CALL iom_put( 'qemp_oce'   , qemp_oce                                                   )   ! Downward Heat Flux from E-P over ocean 
     258      IF( iom_use('qemp_ice'   ) )   CALL iom_put( 'qemp_ice'   , qemp_ice                                                   )   ! Downward Heat Flux from E-P over ice 
    259259 
    260260      ! heat fluxes from ice transformations 
    261       !                              ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr ) 
    262       IF( iom_use('hfxbog'     ) )   CALL iom_put ("hfxbog"     , hfx_bog             )   ! heat flux used for ice bottom growth  
    263       IF( iom_use('hfxbom'     ) )   CALL iom_put ("hfxbom"     , hfx_bom             )   ! heat flux used for ice bottom melt 
    264       IF( iom_use('hfxsum'     ) )   CALL iom_put ("hfxsum"     , hfx_sum             )   ! heat flux used for ice surface melt 
    265       IF( iom_use('hfxopw'     ) )   CALL iom_put ("hfxopw"     , hfx_opw             )   ! heat flux used for ice formation in open water 
    266       IF( iom_use('hfxdif'     ) )   CALL iom_put ("hfxdif"     , hfx_dif             )   ! heat flux used for ice temperature change 
    267       IF( iom_use('hfxsnw'     ) )   CALL iom_put ("hfxsnw"     , hfx_snw             )   ! heat flux used for snow melt  
    268       IF( iom_use('hfxerr'     ) )   CALL iom_put ("hfxerr"     , hfx_err_dif        )   ! heat flux error after heat diffusion (included in qt_oce_ai) 
     261      !                            ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr ) 
     262      CALL iom_put ('hfxbog'     , hfx_bog     )   ! heat flux used for ice bottom growth  
     263      CALL iom_put ('hfxbom'     , hfx_bom     )   ! heat flux used for ice bottom melt 
     264      CALL iom_put ('hfxsum'     , hfx_sum     )   ! heat flux used for ice surface melt 
     265      CALL iom_put ('hfxopw'     , hfx_opw     )   ! heat flux used for ice formation in open water 
     266      CALL iom_put ('hfxdif'     , hfx_dif     )   ! heat flux used for ice temperature change 
     267      CALL iom_put ('hfxsnw'     , hfx_snw     )   ! heat flux used for snow melt  
     268      CALL iom_put ('hfxerr'     , hfx_err_dif )   ! heat flux error after heat diffusion (included in qt_oce_ai) 
    269269 
    270270      ! heat fluxes associated with mass exchange (freeze/melt/precip...) 
    271       IF( iom_use('hfxthd'     ) )   CALL iom_put ("hfxthd"     , hfx_thd             )   !   
    272       IF( iom_use('hfxdyn'     ) )   CALL iom_put ("hfxdyn"     , hfx_dyn             )   !   
    273       IF( iom_use('hfxres'     ) )   CALL iom_put ("hfxres"     , hfx_res             )   !   
    274       IF( iom_use('hfxsub'     ) )   CALL iom_put ("hfxsub"     , hfx_sub             )   !   
    275       IF( iom_use('hfxspr'     ) )   CALL iom_put ("hfxspr"     , hfx_spr             )   ! Heat flux from snow precip heat content  
     271      CALL iom_put ('hfxthd'     , hfx_thd     )   !   
     272      CALL iom_put ('hfxdyn'     , hfx_dyn     )   !   
     273      CALL iom_put ('hfxres'     , hfx_res     )   !   
     274      CALL iom_put ('hfxsub'     , hfx_sub     )   !   
     275      CALL iom_put ('hfxspr'     , hfx_spr     )   ! Heat flux from snow precip heat content  
    276276 
    277277      ! other heat fluxes 
    278       IF( iom_use('hfxsensib'  ) )   CALL iom_put( "hfxsensib"  ,     -qsb_ice_bot * at_i_b         )   ! Sensible oceanic heat flux 
    279       IF( iom_use('hfxcndbot'  ) )   CALL iom_put( "hfxcndbot"  , SUM( qcn_ice_bot * a_i_b, dim=3 ) )   ! Bottom conduction flux 
    280       IF( iom_use('hfxcndtop'  ) )   CALL iom_put( "hfxcndtop"  , SUM( qcn_ice_top * a_i_b, dim=3 ) )   ! Surface conduction flux 
    281  
    282       ! diags 
    283       IF( iom_use('hfxdhc'     ) )   CALL iom_put ("hfxdhc"     , diag_heat           )   ! Heat content variation in snow and ice  
    284       ! 
     278      IF( iom_use('hfxsensib'  ) )   CALL iom_put( 'hfxsensib'  ,     -qsb_ice_bot * at_i_b         )   ! Sensible oceanic heat flux 
     279      IF( iom_use('hfxcndbot'  ) )   CALL iom_put( 'hfxcndbot'  , SUM( qcn_ice_bot * a_i_b, dim=3 ) )   ! Bottom conduction flux 
     280      IF( iom_use('hfxcndtop'  ) )   CALL iom_put( 'hfxcndtop'  , SUM( qcn_ice_top * a_i_b, dim=3 ) )   ! Surface conduction flux 
     281 
    285282      ! controls 
    286283      !--------- 
     
    413410      !! ** Method  :   use of IOM library 
    414411      !!---------------------------------------------------------------------- 
    415       CHARACTER(len=*) , INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
     412      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! 'READ'/'WRITE' flag 
    416413      INTEGER, OPTIONAL, INTENT(in) ::   kt     ! ice time-step 
    417414      ! 
  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/ICE/icevar.F90

    r11229 r11573  
    3232   !!                        - vt_s(jpi,jpj) 
    3333   !!                        - at_i(jpi,jpj) 
     34   !!                        - st_i(jpi,jpj) 
    3435   !!                        - et_s(jpi,jpj)  total snow heat content 
    3536   !!                        - et_i(jpi,jpj)  total ice thermal content  
     
    4647   !!   ice_var_zapneg    : remove negative ice fields 
    4748   !!   ice_var_roundoff  : remove negative values arising from roundoff erros 
    48    !!   ice_var_itd       : convert 1-cat to jpl-cat 
    49    !!   ice_var_itd2      : convert N-cat to jpl-cat 
    5049   !!   ice_var_bv        : brine volume 
    5150   !!   ice_var_enthalpy  : compute ice and snow enthalpies from temperature 
    5251   !!   ice_var_sshdyn    : compute equivalent ssh in lead 
     52   !!   ice_var_itd       : convert N-cat to M-cat 
    5353   !!---------------------------------------------------------------------- 
    5454   USE dom_oce        ! ocean space and time domain 
     
    104104      ! 
    105105      !                                      ! integrated values 
    106       vt_i(:,:) =       SUM( v_i(:,:,:)           , dim=3 ) 
    107       vt_s(:,:) =       SUM( v_s(:,:,:)           , dim=3 ) 
    108       at_i(:,:) =       SUM( a_i(:,:,:)           , dim=3 ) 
    109       et_s(:,:)  = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 ) 
    110       et_i(:,:)  = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 ) 
     106      vt_i(:,:) =       SUM( v_i (:,:,:)           , dim=3 ) 
     107      vt_s(:,:) =       SUM( v_s (:,:,:)           , dim=3 ) 
     108      st_i(:,:) =       SUM( sv_i(:,:,:)           , dim=3 ) 
     109      at_i(:,:) =       SUM( a_i (:,:,:)           , dim=3 ) 
     110      et_s(:,:)  = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 ) 
     111      et_i(:,:)  = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 ) 
    111112      ! 
    112113      at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds 
     
    138139         tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    139140         om_i (:,:) = SUM( oa_i(:,:,:)              , dim=3 ) * z1_at_i(:,:) 
    140          sm_i (:,:) = SUM( sv_i(:,:,:)              , dim=3 ) * z1_vt_i(:,:) 
     141         sm_i (:,:) =      st_i(:,:)                          * z1_vt_i(:,:) 
    141142         ! 
    142143         tm_i(:,:) = 0._wp 
     
    158159            tm_s (:,:) = rt0 
    159160         END WHERE 
    160  
     161         ! 
     162         !                           ! mean melt pond depth 
     163         WHERE( at_ip(:,:) > epsi20 )   ;   hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) 
     164         ELSEWHERE                      ;   hm_ip(:,:) = 0._wp 
     165         END WHERE          
     166         ! 
    161167         DEALLOCATE( z1_at_i , z1_vt_i , z1_vt_s ) 
     168         ! 
    162169      ENDIF 
    163170      ! 
     
    263270      ! 
    264271      ! integrated values  
    265       vt_i (:,:) = SUM( v_i, dim=3 ) 
    266       vt_s (:,:) = SUM( v_s, dim=3 ) 
    267       at_i (:,:) = SUM( a_i, dim=3 ) 
     272      vt_i (:,:) = SUM( v_i , dim=3 ) 
     273      vt_s (:,:) = SUM( v_s , dim=3 ) 
     274      at_i (:,:) = SUM( a_i , dim=3 ) 
    268275      ! 
    269276   END SUBROUTINE ice_var_glo2eqv 
     
    533540 
    534541      ! to be sure that at_i is the sum of a_i(jl) 
    535       at_i (:,:) = SUM( a_i(:,:,:), dim=3 ) 
    536       vt_i (:,:) = SUM( v_i(:,:,:), dim=3 ) 
     542      at_i (:,:) = SUM( a_i (:,:,:), dim=3 ) 
     543      vt_i (:,:) = SUM( v_i (:,:,:), dim=3 ) 
     544!!clem add? 
     545!      vt_s (:,:) = SUM( v_s (:,:,:), dim=3 ) 
     546!      st_i (:,:) = SUM( sv_i(:,:,:), dim=3 ) 
     547!      et_s(:,:)  = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 ) 
     548!      et_i(:,:)  = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 ) 
     549!!clem 
    537550 
    538551      ! open water = 1 if at_i=0 
     
    652665      WHERE( pe_i (1:npti,:,:) < 0._wp .AND. pe_i (1:npti,:,:) > -epsi06 )   pe_i (1:npti,:,:) = 0._wp   !  e_i must be >= 0 
    653666      WHERE( pe_s (1:npti,:,:) < 0._wp .AND. pe_s (1:npti,:,:) > -epsi06 )   pe_s (1:npti,:,:) = 0._wp   !  e_s must be >= 0 
    654       IF ( ln_pnd_H12 ) THEN 
     667      IF( ln_pnd_H12 ) THEN 
    655668         WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10 )    pa_ip(1:npti,:)   = 0._wp   ! a_ip must be >= 0 
    656669         WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 )    pv_ip(1:npti,:)   = 0._wp   ! v_ip must be >= 0 
     
    773786   !! ** Purpose :  converting N-cat ice to jpl ice categories 
    774787   !!------------------------------------------------------------------- 
    775    SUBROUTINE ice_var_itd_1c1c( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     788   SUBROUTINE ice_var_itd_1c1c( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
     789      &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
    776790      !!------------------------------------------------------------------- 
    777791      !! ** Purpose :  converting 1-cat ice to 1 ice category 
    778792      !!------------------------------------------------------------------- 
    779       REAL(wp), DIMENSION(:), INTENT(in)    ::   zhti, zhts, zati    ! input ice/snow variables 
    780       REAL(wp), DIMENSION(:), INTENT(inout) ::   zh_i, zh_s, za_i    ! output ice/snow variables 
    781       !!------------------------------------------------------------------- 
    782       zh_i(:) = zhti(:) 
    783       zh_s(:) = zhts(:) 
    784       za_i(:) = zati(:) 
     793      REAL(wp), DIMENSION(:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
     794      REAL(wp), DIMENSION(:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
     795      REAL(wp), DIMENSION(:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
     796      REAL(wp), DIMENSION(:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     797      !!------------------------------------------------------------------- 
     798      ! == thickness and concentration == ! 
     799      ph_i(:) = phti(:) 
     800      ph_s(:) = phts(:) 
     801      pa_i(:) = pati(:) 
     802      ! 
     803      ! == temperature and salinity and ponds == ! 
     804      pt_i (:) = ptmi (:) 
     805      pt_s (:) = ptms (:) 
     806      pt_su(:) = ptmsu(:) 
     807      ps_i (:) = psmi (:) 
     808      pa_ip(:) = patip(:) 
     809      ph_ip(:) = phtip(:) 
     810       
    785811   END SUBROUTINE ice_var_itd_1c1c 
    786812 
    787    SUBROUTINE ice_var_itd_Nc1c( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     813   SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
     814      &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
    788815      !!------------------------------------------------------------------- 
    789816      !! ** Purpose :  converting N-cat ice to 1 ice category 
    790817      !!------------------------------------------------------------------- 
    791       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   zhti, zhts, zati    ! input ice/snow variables 
    792       REAL(wp), DIMENSION(:)  , INTENT(inout) ::   zh_i, zh_s, za_i    ! output ice/snow variables 
    793       !!------------------------------------------------------------------- 
    794       ! 
    795       za_i(:) = SUM( zati(:,:), dim=2 ) 
    796       ! 
    797       WHERE( za_i(:) /= 0._wp ) 
    798          zh_i(:) = SUM( zhti(:,:) * zati(:,:), dim=2 ) / za_i(:) 
    799          zh_s(:) = SUM( zhts(:,:) * zati(:,:), dim=2 ) / za_i(:) 
    800       ELSEWHERE 
    801          zh_i(:) = 0._wp 
    802          zh_s(:) = 0._wp 
     818      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
     819      REAL(wp), DIMENSION(:)  , INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
     820      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
     821      REAL(wp), DIMENSION(:)  , INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     822      ! 
     823      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   z1_ai, z1_vi, z1_vs 
     824      ! 
     825      INTEGER ::   idim   
     826      !!------------------------------------------------------------------- 
     827      ! 
     828      idim = SIZE( phti, 1 ) 
     829      ! 
     830      ! == thickness and concentration == ! 
     831      ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim) ) 
     832      ! 
     833      pa_i(:) = SUM( pati(:,:), dim=2 ) 
     834 
     835      WHERE( ( pa_i(:) ) /= 0._wp )   ;   z1_ai(:) = 1._wp / pa_i(:) 
     836      ELSEWHERE                       ;   z1_ai(:) = 0._wp 
    803837      END WHERE 
     838 
     839      ph_i(:) = SUM( phti(:,:) * pati(:,:), dim=2 ) * z1_ai(:) 
     840      ph_s(:) = SUM( phts(:,:) * pati(:,:), dim=2 ) * z1_ai(:) 
     841      ! 
     842      ! == temperature and salinity == ! 
     843      WHERE( ( pa_i(:) * ph_i(:) ) /= 0._wp )   ;   z1_vi(:) = 1._wp / ( pa_i(:) * ph_i(:) ) 
     844      ELSEWHERE                                 ;   z1_vi(:) = 0._wp 
     845      END WHERE 
     846      WHERE( ( pa_i(:) * ph_s(:) ) /= 0._wp )   ;   z1_vs(:) = 1._wp / ( pa_i(:) * ph_s(:) ) 
     847      ELSEWHERE                                 ;   z1_vs(:) = 0._wp 
     848      END WHERE 
     849      pt_i (:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 
     850      pt_s (:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 
     851      pt_su(:) = SUM( ptmsu(:,:) * pati(:,:)            , dim=2 ) * z1_ai(:) 
     852      ps_i (:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 
     853 
     854      ! == ponds == ! 
     855      pa_ip(:) = SUM( patip(:,:), dim=2 ) 
     856      WHERE( pa_ip(:) /= 0._wp )   ;   ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
     857      ELSEWHERE                    ;   ph_ip(:) = 0._wp 
     858      END WHERE 
     859      ! 
     860      DEALLOCATE( z1_ai, z1_vi, z1_vs ) 
    804861      ! 
    805862   END SUBROUTINE ice_var_itd_Nc1c 
    806863    
    807    SUBROUTINE ice_var_itd_1cMc( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     864   SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
     865      &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
    808866      !!------------------------------------------------------------------- 
    809867      !! 
    810868      !! ** Purpose :  converting 1-cat ice to jpl ice categories 
    811869      !! 
    812       !!                  ice thickness distribution follows a gaussian law 
    813       !!               around the concentration of the most likely ice thickness 
    814       !!                           (similar as iceistate.F90) 
    815       !! 
    816       !! ** Method:   Iterative procedure 
    817       !!                 
    818       !!               1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian 
    819       !! 
    820       !!               2) Check whether the distribution conserves area and volume, positivity and 
    821       !!                  category boundaries 
     870      !! 
     871      !! ** Method:   ice thickness distribution follows a gamma function from Abraham et al. (2015) 
     872      !!              it has the property of conserving total concentration and volume 
    822873      !!               
    823       !!               3) If not (input ice is too thin), the last category is empty and 
    824       !!                  the number of categories is reduced (jpl-1) 
    825       !! 
    826       !!               4) Iterate until ok (SUM(itest(:) = 4) 
    827       !! 
    828       !! ** Arguments : zhti: 1-cat ice thickness 
    829       !!                zhts: 1-cat snow depth 
    830       !!                zati: 1-cat ice concentration 
     874      !! 
     875      !! ** Arguments : phti: 1-cat ice thickness 
     876      !!                phts: 1-cat snow depth 
     877      !!                pati: 1-cat ice concentration 
    831878      !! 
    832879      !! ** Output    : jpl-cat  
    833880      !! 
    834       !!  (Example of application: BDY forcings when input are cell averaged)   
    835       !!------------------------------------------------------------------- 
    836       INTEGER  :: ji, jk, jl             ! dummy loop indices 
    837       INTEGER  :: idim, i_fill, jl0   
    838       REAL(wp) :: zarg, zV, zconv, zdh, zdv 
    839       REAL(wp), DIMENSION(:),   INTENT(in)    ::   zhti, zhts, zati    ! input  ice/snow variables 
    840       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zh_i, zh_s, za_i    ! output ice/snow variables 
    841       INTEGER , DIMENSION(4)                  ::   itest 
    842       !!------------------------------------------------------------------- 
    843       ! 
    844       ! ---------------------------------------- 
    845       ! distribution over the jpl ice categories 
    846       ! ---------------------------------------- 
    847       ! a gaussian distribution for ice concentration is used 
    848       ! then we check whether the distribution fullfills 
    849       ! volume and area conservation, positivity and ice categories bounds 
    850       idim = SIZE( zhti , 1 ) 
    851       zh_i(1:idim,1:jpl) = 0._wp 
    852       zh_s(1:idim,1:jpl) = 0._wp 
    853       za_i(1:idim,1:jpl) = 0._wp 
    854       ! 
     881      !!  Abraham, C., Steiner, N., Monahan, A. and Michel, C., 2015. 
     882      !!               Effects of subgrid‐scale snow thickness variability on radiative transfer in sea ice. 
     883      !!               Journal of Geophysical Research: Oceans, 120(8), pp.5597-5614  
     884      !!------------------------------------------------------------------- 
     885      REAL(wp), DIMENSION(:),   INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
     886      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
     887      REAL(wp), DIMENSION(:)  , INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
     888      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     889      ! 
     890      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zfra, z1_hti 
     891      INTEGER  ::   ji, jk, jl 
     892      INTEGER  ::   idim 
     893      REAL(wp) ::   zv, zdh 
     894      !!------------------------------------------------------------------- 
     895      ! 
     896      idim = SIZE( phti , 1 ) 
     897      ! 
     898      ph_i(1:idim,1:jpl) = 0._wp 
     899      ph_s(1:idim,1:jpl) = 0._wp 
     900      pa_i(1:idim,1:jpl) = 0._wp 
     901      ! 
     902      ALLOCATE( z1_hti(idim) ) 
     903      WHERE( phti(:) /= 0._wp )   ;   z1_hti(:) = 1._wp / phti(:) 
     904      ELSEWHERE                   ;   z1_hti(:) = 0._wp 
     905      END WHERE 
     906      ! 
     907      ! == thickness and concentration == ! 
     908      ! for categories 1:jpl-1, integrate the gamma function from hi_max(jl-1) to hi_max(jl) 
     909      DO jl = 1, jpl-1 
     910         DO ji = 1, idim 
     911            ! 
     912            IF( phti(ji) > 0._wp ) THEN 
     913               ! concentration : integrate ((4A/H^2)xexp(-2x/H))dx from x=hi_max(jl-1) to hi_max(jl) 
     914               pa_i(ji,jl) = pati(ji) * z1_hti(ji) * (  ( phti(ji) + 2.*hi_max(jl-1) ) * EXP( -2.*hi_max(jl-1)*z1_hti(ji) ) & 
     915                  &                                   - ( phti(ji) + 2.*hi_max(jl  ) ) * EXP( -2.*hi_max(jl  )*z1_hti(ji) ) ) 
     916               ! 
     917               ! volume : integrate ((4A/H^2)x^2exp(-2x/H))dx from x=hi_max(jl-1) to hi_max(jl) 
     918               zv = pati(ji) * z1_hti(ji) * (  ( phti(ji)*phti(ji) + 2.*phti(ji)*hi_max(jl-1) + 2.*hi_max(jl-1)*hi_max(jl-1) ) & 
     919                  &                            * EXP( -2.*hi_max(jl-1)*z1_hti(ji) ) & 
     920                  &                          - ( phti(ji)*phti(ji) + 2.*phti(ji)*hi_max(jl) + 2.*hi_max(jl)*hi_max(jl) ) & 
     921                  &                            * EXP(-2.*hi_max(jl)*z1_hti(ji)) ) 
     922               ! thickness 
     923               IF( pa_i(ji,jl) > epsi06 ) THEN 
     924                  ph_i(ji,jl) = zv / pa_i(ji,jl) 
     925               ELSE 
     926                  ph_i(ji,jl) = 0. 
     927                  pa_i(ji,jl) = 0. 
     928               ENDIF 
     929            ENDIF 
     930            ! 
     931         ENDDO 
     932      ENDDO 
     933      ! 
     934      ! for the last category (jpl), integrate the gamma function from hi_max(jpl-1) to infinity 
    855935      DO ji = 1, idim 
    856936         ! 
    857          IF( zhti(ji) > 0._wp ) THEN 
    858             ! 
    859             ! find which category (jl0) the input ice thickness falls into 
    860             jl0 = jpl 
    861             DO jl = 1, jpl 
    862                IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 
    863                   jl0 = jl 
    864                   CYCLE 
    865                ENDIF 
    866             END DO 
    867             ! 
    868             itest(:) = 0 
    869             i_fill   = jpl + 1                                            !------------------------------------ 
    870             DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )   ! iterative loop on i_fill categories 
    871                !                                                          !------------------------------------ 
    872                i_fill = i_fill - 1 
    873                ! 
    874                zh_i(ji,1:jpl) = 0._wp 
    875                za_i(ji,1:jpl) = 0._wp 
    876                itest(:)       = 0       
    877                ! 
    878                IF ( i_fill == 1 ) THEN      !-- case very thin ice: fill only category 1 
    879                   zh_i(ji,1) = zhti(ji) 
    880                   za_i (ji,1) = zati (ji) 
    881                ELSE                         !-- case ice is thicker: fill categories >1 
    882                   ! thickness 
    883                   DO jl = 1, i_fill - 1 
    884                      zh_i(ji,jl) = hi_mean(jl) 
    885                   END DO 
    886                   ! 
    887                   ! concentration 
    888                   za_i(ji,jl0) = zati(ji) / SQRT(REAL(jpl)) 
    889                   DO jl = 1, i_fill - 1 
    890                      IF ( jl /= jl0 ) THEN 
    891                         zarg        = ( zh_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp ) 
    892                         za_i(ji,jl) =   za_i (ji,jl0) * EXP(-zarg**2) 
    893                      ENDIF 
    894                   END DO 
    895                   ! 
    896                   ! last category 
    897                   za_i(ji,i_fill) = zati(ji) - SUM( za_i(ji,1:i_fill-1) ) 
    898                   zV = SUM( za_i(ji,1:i_fill-1) * zh_i(ji,1:i_fill-1) ) 
    899                   zh_i(ji,i_fill) = ( zhti(ji) * zati(ji) - zV ) / MAX( za_i(ji,i_fill), epsi10 )  
    900                   ! 
    901                   ! correction if concentration of upper cat is greater than lower cat 
    902                   !    (it should be a gaussian around jl0 but sometimes it is not) 
    903                   IF ( jl0 /= jpl ) THEN 
    904                      DO jl = jpl, jl0+1, -1 
    905                         IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN 
    906                            zdv = zh_i(ji,jl) * za_i(ji,jl) 
    907                            zh_i(ji,jl    ) = 0._wp 
    908                            za_i (ji,jl    ) = 0._wp 
    909                            za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 ) 
    910                         END IF 
    911                      END DO 
    912                   ENDIF 
    913                   ! 
    914                ENDIF 
    915                ! 
    916                ! Compatibility tests 
    917                zconv = ABS( zati(ji) - SUM( za_i(ji,1:jpl) ) )  
    918                IF ( zconv < epsi06 )   itest(1) = 1                                        ! Test 1: area conservation 
    919                ! 
    920                zconv = ABS( zhti(ji)*zati(ji) - SUM( za_i(ji,1:jpl)*zh_i(ji,1:jpl) ) ) 
    921                IF ( zconv < epsi06 )   itest(2) = 1                                        ! Test 2: volume conservation 
    922                ! 
    923                IF ( zh_i(ji,i_fill) >= hi_max(i_fill-1) )   itest(3) = 1                  ! Test 3: thickness of the last category is in-bounds ? 
    924                ! 
    925                itest(4) = 1 
    926                DO jl = 1, i_fill 
    927                   IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0                                ! Test 4: positivity of ice concentrations 
    928                END DO 
    929                !                                         !---------------------------- 
    930             END DO                                       ! end iteration on categories 
    931             !                                            !---------------------------- 
     937         IF( phti(ji) > 0._wp ) THEN 
     938            ! concentration : integrate ((4A/H^2)xexp(-2x/H))dx from x=hi_max(jpl-1) to infinity 
     939            pa_i(ji,jpl) = pati(ji) * z1_hti(ji) * ( phti(ji) + 2.*hi_max(jpl-1) ) * EXP( -2.*hi_max(jpl-1)*z1_hti(ji) ) 
     940 
     941            ! volume : integrate ((4A/H^2)x^2exp(-2x/H))dx from x=hi_max(jpl-1) to infinity 
     942            zv = pati(ji) * z1_hti(ji) * ( phti(ji)*phti(ji) + 2.*phti(ji)*hi_max(jpl-1) + 2.*hi_max(jpl-1)*hi_max(jpl-1) ) & 
     943               &                         * EXP( -2.*hi_max(jpl-1)*z1_hti(ji) ) 
     944            ! thickness 
     945            IF( pa_i(ji,jpl) > epsi06 ) THEN 
     946               ph_i(ji,jpl) = zv / pa_i(ji,jpl) 
     947            else 
     948               ph_i(ji,jpl) = 0. 
     949               pa_i(ji,jpl) = 0. 
     950            ENDIF 
    932951         ENDIF 
    933       END DO 
    934  
    935       ! Add Snow in each category where za_i is not 0 
     952         ! 
     953      ENDDO 
     954      ! 
     955      ! Add Snow in each category where pa_i is not 0 
    936956      DO jl = 1, jpl 
    937957         DO ji = 1, idim 
    938             IF( za_i(ji,jl) > 0._wp ) THEN 
    939                zh_s(ji,jl) = zh_i(ji,jl) * ( zhts(ji) / zhti(ji) ) 
     958            IF( pa_i(ji,jl) > 0._wp ) THEN 
     959               ph_s(ji,jl) = ph_i(ji,jl) * phts(ji) * z1_hti(ji) 
    940960               ! In case snow load is in excess that would lead to transformation from snow to ice 
    941961               ! Then, transfer the snow excess into the ice (different from icethd_dh) 
    942                zdh = MAX( 0._wp, ( rhos * zh_s(ji,jl) + ( rhoi - rau0 ) * zh_i(ji,jl) ) * r1_rau0 )  
     962               zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rau0 ) * ph_i(ji,jl) ) * r1_rau0 )  
    943963               ! recompute h_i, h_s avoiding out of bounds values 
    944                zh_i(ji,jl) = MIN( hi_max(jl), zh_i(ji,jl) + zdh ) 
    945                zh_s(ji,jl) = MAX( 0._wp, zh_s(ji,jl) - zdh * rhoi * r1_rhos ) 
     964               ph_i(ji,jl) = MIN( hi_max(jl), ph_i(ji,jl) + zdh ) 
     965               ph_s(ji,jl) = MAX( 0._wp, ph_s(ji,jl) - zdh * rhoi * r1_rhos ) 
    946966            ENDIF 
    947967         END DO 
    948968      END DO 
    949969      ! 
     970      DEALLOCATE( z1_hti ) 
     971      ! 
     972      ! == temperature and salinity == ! 
     973      DO jl = 1, jpl 
     974         pt_i (:,jl) = ptmi (:) 
     975         pt_s (:,jl) = ptms (:) 
     976         pt_su(:,jl) = ptmsu(:) 
     977         ps_i (:,jl) = psmi (:) 
     978         ps_i (:,jl) = psmi (:)          
     979      END DO 
     980      ! 
     981      ! == ponds == ! 
     982      ALLOCATE( zfra(idim) ) 
     983      ! keep the same pond fraction atip/ati for each category 
     984      WHERE( pati(:) /= 0._wp )   ;   zfra(:) = patip(:) / pati(:) 
     985      ELSEWHERE                   ;   zfra(:) = 0._wp 
     986      END WHERE 
     987      DO jl = 1, jpl 
     988         pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 
     989      END DO 
     990      ! keep the same v_ip/v_i ratio for each category 
     991      WHERE( ( phti(:) * pati(:) ) /= 0._wp )   ;   zfra(:) = ( phtip(:) * patip(:) ) / ( phti(:) * pati(:) ) 
     992      ELSEWHERE                                 ;   zfra(:) = 0._wp 
     993      END WHERE 
     994      DO jl = 1, jpl 
     995         WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     996         ELSEWHERE                       ;   ph_ip(:,jl) = 0._wp 
     997         END WHERE 
     998      END DO 
     999      DEALLOCATE( zfra ) 
     1000      ! 
    9501001   END SUBROUTINE ice_var_itd_1cMc 
    9511002 
    952    SUBROUTINE ice_var_itd_NcMc( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     1003   SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
     1004      &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
    9531005      !!------------------------------------------------------------------- 
    9541006      !! 
     
    9711023      !!                      b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin) 
    9721024      !! 
    973       !! ** Arguments : zhti: N-cat ice thickness 
    974       !!                zhts: N-cat snow depth 
    975       !!                zati: N-cat ice concentration 
     1025      !! ** Arguments : phti: N-cat ice thickness 
     1026      !!                phts: N-cat snow depth 
     1027      !!                pati: N-cat ice concentration 
    9761028      !! 
    9771029      !! ** Output    : jpl-cat  
     
    9791031      !!  (Example of application: BDY forcings when inputs have N-cat /= jpl)   
    9801032      !!------------------------------------------------------------------- 
    981       INTEGER  ::   ji, jl, jl1, jl2             ! dummy loop indices 
     1033      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
     1034      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
     1035      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
     1036      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     1037      ! 
     1038      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   jlfil, jlfil2 
     1039      INTEGER , ALLOCATABLE, DIMENSION(:)   ::   jlmax, jlmin 
     1040      REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   z1_ai, z1_vi, z1_vs, ztmp, zfra 
     1041      ! 
     1042      REAL(wp), PARAMETER ::   ztrans = 0.25_wp 
     1043      INTEGER  ::   ji, jl, jl1, jl2 
    9821044      INTEGER  ::   idim, icat   
    983       REAL(wp), PARAMETER ::   ztrans = 0.25_wp 
    984       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   zhti, zhts, zati    ! input ice/snow variables 
    985       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zh_i, zh_s, za_i    ! output ice/snow variables 
    986       INTEGER , DIMENSION(:,:), ALLOCATABLE   ::   jlfil, jlfil2 
    987       INTEGER , DIMENSION(:)  , ALLOCATABLE   ::   jlmax, jlmin 
    988       !!------------------------------------------------------------------- 
    989       ! 
    990       idim = SIZE( zhti, 1 ) 
    991       icat = SIZE( zhti, 2 ) 
     1045      !!------------------------------------------------------------------- 
     1046      ! 
     1047      idim = SIZE( phti, 1 ) 
     1048      icat = SIZE( phti, 2 ) 
     1049      ! 
     1050      ! == thickness and concentration == ! 
    9921051      !                                 ! ---------------------- ! 
    9931052      IF( icat == jpl ) THEN            ! input cat = output cat ! 
    9941053         !                              ! ---------------------- ! 
    995          zh_i(:,:) = zhti(:,:) 
    996          zh_s(:,:) = zhts(:,:) 
    997          za_i(:,:) = zati(:,:) 
     1054         ph_i(:,:) = phti(:,:) 
     1055         ph_s(:,:) = phts(:,:) 
     1056         pa_i(:,:) = pati(:,:) 
     1057         ! 
     1058         ! == temperature and salinity and ponds == ! 
     1059         pt_i (:,:) = ptmi (:,:) 
     1060         pt_s (:,:) = ptms (:,:) 
     1061         pt_su(:,:) = ptmsu(:,:) 
     1062         ps_i (:,:) = psmi (:,:) 
     1063         pa_ip(:,:) = patip(:,:) 
     1064         ph_ip(:,:) = phtip(:,:) 
    9981065         !                              ! ---------------------- ! 
    9991066      ELSEIF( icat == 1 ) THEN          ! input cat = 1          ! 
    10001067         !                              ! ---------------------- ! 
    1001          CALL  ice_var_itd_1cMc( zhti(:,1), zhts(:,1), zati(:,1), zh_i(:,:), zh_s(:,:), za_i(:,:) ) 
     1068         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 
     1069            &                    ph_i(:,:), ph_s(:,:), pa_i (:,:), & 
     1070            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), & 
     1071            &                    pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:)  ) 
    10021072         !                              ! ---------------------- ! 
    10031073      ELSEIF( jpl == 1 ) THEN           ! output cat = 1         ! 
    10041074         !                              ! ---------------------- ! 
    1005          CALL  ice_var_itd_Nc1c( zhti(:,:), zhts(:,:), zati(:,:), zh_i(:,1), zh_s(:,1), za_i(:,1) )          
     1075         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 
     1076            &                    ph_i(:,1), ph_s(:,1), pa_i (:,1), & 
     1077            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), & 
     1078            &                    pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1)  ) 
    10061079         !                              ! ----------------------- ! 
    10071080      ELSE                              ! input cat /= output cat ! 
     
    10121085 
    10131086         ! --- initialize output fields to 0 --- ! 
    1014          zh_i(1:idim,1:jpl) = 0._wp 
    1015          zh_s(1:idim,1:jpl) = 0._wp 
    1016          za_i(1:idim,1:jpl) = 0._wp 
     1087         ph_i(1:idim,1:jpl) = 0._wp 
     1088         ph_s(1:idim,1:jpl) = 0._wp 
     1089         pa_i(1:idim,1:jpl) = 0._wp 
    10171090         ! 
    10181091         ! --- fill the categories --- ! 
     
    10241097            DO jl2 = 1, icat 
    10251098               DO ji = 1, idim 
    1026                   IF( hi_max(jl1-1) <= zhti(ji,jl2) .AND. hi_max(jl1) > zhti(ji,jl2) ) THEN 
     1099                  IF( hi_max(jl1-1) <= phti(ji,jl2) .AND. hi_max(jl1) > phti(ji,jl2) ) THEN 
    10271100                     ! fill the right category 
    1028                      zh_i(ji,jl1) = zhti(ji,jl2) 
    1029                      zh_s(ji,jl1) = zhts(ji,jl2) 
    1030                      za_i(ji,jl1) = zati(ji,jl2) 
     1101                     ph_i(ji,jl1) = phti(ji,jl2) 
     1102                     ph_s(ji,jl1) = phts(ji,jl2) 
     1103                     pa_i(ji,jl1) = pati(ji,jl2) 
    10311104                     ! record categories that are filled 
    10321105                     jlmax(ji) = MAX( jlmax(ji), jl1 ) 
     
    10451118            IF( jl1 > 1 ) THEN 
    10461119               ! fill the lower cat (jl1-1) 
    1047                za_i(ji,jl1-1) = ztrans * za_i(ji,jl1) 
    1048                zh_i(ji,jl1-1) = hi_mean(jl1-1) 
     1120               pa_i(ji,jl1-1) = ztrans * pa_i(ji,jl1) 
     1121               ph_i(ji,jl1-1) = hi_mean(jl1-1) 
    10491122               ! remove from cat jl1 
    1050                za_i(ji,jl1  ) = ( 1._wp - ztrans ) * za_i(ji,jl1) 
     1123               pa_i(ji,jl1  ) = ( 1._wp - ztrans ) * pa_i(ji,jl1) 
    10511124            ENDIF 
    10521125            IF( jl2 < jpl ) THEN 
    10531126               ! fill the upper cat (jl2+1) 
    1054                za_i(ji,jl2+1) = ztrans * za_i(ji,jl2) 
    1055                zh_i(ji,jl2+1) = hi_mean(jl2+1) 
     1127               pa_i(ji,jl2+1) = ztrans * pa_i(ji,jl2) 
     1128               ph_i(ji,jl2+1) = hi_mean(jl2+1) 
    10561129               ! remove from cat jl2 
    1057                za_i(ji,jl2  ) = ( 1._wp - ztrans ) * za_i(ji,jl2) 
     1130               pa_i(ji,jl2  ) = ( 1._wp - ztrans ) * pa_i(ji,jl2) 
    10581131            ENDIF 
    10591132         END DO 
     
    10651138               IF( jlfil(ji,jl-1) /= 0 .AND. jlfil(ji,jl) == 0 ) THEN 
    10661139                  ! fill high 
    1067                   za_i(ji,jl) = ztrans * za_i(ji,jl-1) 
    1068                   zh_i(ji,jl) = hi_mean(jl) 
     1140                  pa_i(ji,jl) = ztrans * pa_i(ji,jl-1) 
     1141                  ph_i(ji,jl) = hi_mean(jl) 
    10691142                  jlfil(ji,jl) = jl 
    10701143                  ! remove low 
    1071                   za_i(ji,jl-1) = ( 1._wp - ztrans ) * za_i(ji,jl-1) 
     1144                  pa_i(ji,jl-1) = ( 1._wp - ztrans ) * pa_i(ji,jl-1) 
    10721145               ENDIF 
    10731146            END DO 
     
    10791152               IF( jlfil2(ji,jl+1) /= 0 .AND. jlfil2(ji,jl) == 0 ) THEN 
    10801153                  ! fill low 
    1081                   za_i(ji,jl) = za_i(ji,jl) + ztrans * za_i(ji,jl+1) 
    1082                   zh_i(ji,jl) = hi_mean(jl)  
     1154                  pa_i(ji,jl) = pa_i(ji,jl) + ztrans * pa_i(ji,jl+1) 
     1155                  ph_i(ji,jl) = hi_mean(jl)