Changeset 11536 for NEMO/trunk/src


Ignore:
Timestamp:
2019-09-11T15:54:18+02:00 (20 months ago)
Author:
smasson
Message:

trunk: merge dev_r10984_HPC-13 into the trunk

Location:
NEMO/trunk/src
Files:
2 deleted
176 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/ICE/ice.F90

    r10882 r11536  
    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/trunk/src/ICE/icealb.F90

    r10535 r11536  
    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/trunk/src/ICE/icecor.F90

    r10994 r11536  
    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/trunk/src/ICE/icectl.F90

    r10994 r11536  
    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/trunk/src/ICE/icedia.F90

    r10425 r11536  
    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/trunk/src/ICE/icedyn.F90

    r10994 r11536  
    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/trunk/src/ICE/icedyn_adv.F90

    r10911 r11536  
    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/trunk/src/ICE/icedyn_rdgrft.F90

    r10994 r11536  
    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 
    278280      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 
     281      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icedyn_rdgrft',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    280282      IF( ln_timing    )   CALL timing_stop ('icedyn_rdgrft')                                                             ! timing 
    281283      ! 
     
    916918      REWIND( numnam_ice_ref )              ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 
    917919      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 ) 
     920901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist' ) 
    919921      REWIND( numnam_ice_cfg )              ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution 
    920922      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 ) 
     923902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist' ) 
    922924      IF(lwm) WRITE ( numoni, namdyn_rdgrft ) 
    923925      ! 
  • NEMO/trunk/src/ICE/icedyn_rhg.F90

    r10911 r11536  
    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/trunk/src/ICE/icedyn_rhg_evp.F90

    r10891 r11536  
    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/trunk/src/ICE/iceistate.F90

    r11229 r11536  
    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/trunk/src/ICE/iceitd.F90

    r10994 r11536  
    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/trunk/src/ICE/icerst.F90

    r10425 r11536  
    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/trunk/src/ICE/icesbc.F90

    r10535 r11536  
    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/trunk/src/ICE/icestp.F90

    r10994 r11536  
    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/trunk/src/ICE/icethd.F90

    r10994 r11536  
    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/trunk/src/ICE/icethd_da.F90

    r10069 r11536  
    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/trunk/src/ICE/icethd_do.F90

    r11229 r11536  
    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/trunk/src/ICE/icethd_pnd.F90

    r10532 r11536  
    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/trunk/src/ICE/icethd_sal.F90

    r10069 r11536  
    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/trunk/src/ICE/icethd_zdf.F90

    r10534 r11536  
    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/trunk/src/ICE/iceupdate.F90

    r10425 r11536  
    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/trunk/src/ICE/icevar.F90

    r11229 r11536  
    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      !! 
     
    826884      !!               4) Iterate until ok (SUM(itest(:) = 4) 
    827885      !! 
    828       !! ** Arguments : zhti: 1-cat ice thickness 
    829       !!                zhts: 1-cat snow depth 
    830       !!                zati: 1-cat ice concentration 
     886      !! ** Arguments : phti: 1-cat ice thickness 
     887      !!                phts: 1-cat snow depth 
     888      !!                pati: 1-cat ice concentration 
    831889      !! 
    832890      !! ** Output    : jpl-cat  
     
    834892      !!  (Example of application: BDY forcings when input are cell averaged)   
    835893      !!------------------------------------------------------------------- 
    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       ! ---------------------------------------- 
     894      REAL(wp), DIMENSION(:),   INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
     895      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
     896      REAL(wp), DIMENSION(:)  , INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
     897      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     898      ! 
     899      INTEGER , DIMENSION(4) ::   itest 
     900      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zfra 
     901      INTEGER  ::   ji, jk, jl 
     902      INTEGER  ::   idim, i_fill, jl0   
     903      REAL(wp) ::   zarg, zV, zconv, zdh, zdv 
     904      !!------------------------------------------------------------------- 
     905      ! 
     906      ! == thickness and concentration == ! 
    845907      ! 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 
     908      !    a gaussian distribution for ice concentration is used 
     909      !    then we check whether the distribution fullfills 
     910      !    volume and area conservation, positivity and ice categories bounds 
     911      idim = SIZE( phti , 1 ) 
     912      ! 
     913      ph_i(1:idim,1:jpl) = 0._wp 
     914      ph_s(1:idim,1:jpl) = 0._wp 
     915      pa_i(1:idim,1:jpl) = 0._wp 
    854916      ! 
    855917      DO ji = 1, idim 
    856918         ! 
    857          IF( zhti(ji) > 0._wp ) THEN 
     919         IF( phti(ji) > 0._wp ) THEN 
    858920            ! 
    859921            ! find which category (jl0) the input ice thickness falls into 
    860922            jl0 = jpl 
    861923            DO jl = 1, jpl 
    862                IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN 
     924               IF ( ( phti(ji) >= hi_max(jl-1) ) .AND. ( phti(ji) < hi_max(jl) ) ) THEN 
    863925                  jl0 = jl 
    864926                  CYCLE 
     
    872934               i_fill = i_fill - 1 
    873935               ! 
    874                zh_i(ji,1:jpl) = 0._wp 
    875                za_i(ji,1:jpl) = 0._wp 
     936               ph_i(ji,1:jpl) = 0._wp 
     937               pa_i(ji,1:jpl) = 0._wp 
    876938               itest(:)       = 0       
    877939               ! 
    878940               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) 
     941                  ph_i(ji,1) = phti(ji) 
     942                  pa_i(ji,1) = pati (ji) 
    881943               ELSE                         !-- case ice is thicker: fill categories >1 
    882944                  ! thickness 
    883945                  DO jl = 1, i_fill - 1 
    884                      zh_i(ji,jl) = hi_mean(jl) 
     946                     ph_i(ji,jl) = hi_mean(jl) 
    885947                  END DO 
    886948                  ! 
    887949                  ! concentration 
    888                   za_i(ji,jl0) = zati(ji) / SQRT(REAL(jpl)) 
     950                  pa_i(ji,jl0) = pati(ji) / SQRT(REAL(jpl)) 
    889951                  DO jl = 1, i_fill - 1 
    890952                     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) 
     953                        zarg        = ( ph_i(ji,jl) - phti(ji) ) / ( phti(ji) * 0.5_wp ) 
     954                        pa_i(ji,jl) =   pa_i (ji,jl0) * EXP(-zarg**2) 
    893955                     ENDIF 
    894956                  END DO 
    895957                  ! 
    896958                  ! 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 )  
     959                  pa_i(ji,i_fill) = pati(ji) - SUM( pa_i(ji,1:i_fill-1) ) 
     960                  zV = SUM( pa_i(ji,1:i_fill-1) * ph_i(ji,1:i_fill-1) ) 
     961                  ph_i(ji,i_fill) = ( phti(ji) * pati(ji) - zV ) / MAX( pa_i(ji,i_fill), epsi10 )  
    900962                  ! 
    901963                  ! correction if concentration of upper cat is greater than lower cat 
     
    903965                  IF ( jl0 /= jpl ) THEN 
    904966                     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 ) 
     967                        IF ( pa_i(ji,jl) > pa_i(ji,jl-1) ) THEN 
     968                           zdv = ph_i(ji,jl) * pa_i(ji,jl) 
     969                           ph_i(ji,jl    ) = 0._wp 
     970                           pa_i (ji,jl    ) = 0._wp 
     971                           pa_i (ji,1:jl-1) = pa_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * phti(ji), epsi10 ) 
    910972                        END IF 
    911973                     END DO 
     
    915977               ! 
    916978               ! Compatibility tests 
    917                zconv = ABS( zati(ji) - SUM( za_i(ji,1:jpl) ) )  
     979               zconv = ABS( pati(ji) - SUM( pa_i(ji,1:jpl) ) )  
    918980               IF ( zconv < epsi06 )   itest(1) = 1                                        ! Test 1: area conservation 
    919981               ! 
    920                zconv = ABS( zhti(ji)*zati(ji) - SUM( za_i(ji,1:jpl)*zh_i(ji,1:jpl) ) ) 
     982               zconv = ABS( phti(ji)*pati(ji) - SUM( pa_i(ji,1:jpl)*ph_i(ji,1:jpl) ) ) 
    921983               IF ( zconv < epsi06 )   itest(2) = 1                                        ! Test 2: volume conservation 
    922984               ! 
    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 ? 
     985               IF ( ph_i(ji,i_fill) >= hi_max(i_fill-1) )   itest(3) = 1                   ! Test 3: thickness of the last category is in-bounds ? 
    924986               ! 
    925987               itest(4) = 1 
    926988               DO jl = 1, i_fill 
    927                   IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0                                ! Test 4: positivity of ice concentrations 
     989                  IF ( pa_i(ji,jl) < 0._wp ) itest(4) = 0                                  ! Test 4: positivity of ice concentrations 
    928990               END DO 
    929991               !                                         !---------------------------- 
     
    933995      END DO 
    934996 
    935       ! Add Snow in each category where za_i is not 0 
     997      ! Add Snow in each category where pa_i is not 0 
    936998      DO jl = 1, jpl 
    937999         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) ) 
     1000            IF( pa_i(ji,jl) > 0._wp ) THEN 
     1001               ph_s(ji,jl) = ph_i(ji,jl) * ( phts(ji) / phti(ji) ) 
    9401002               ! In case snow load is in excess that would lead to transformation from snow to ice 
    9411003               ! 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 )  
     1004               zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rau0 ) * ph_i(ji,jl) ) * r1_rau0 )  
    9431005               ! 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 ) 
     1006               ph_i(ji,jl) = MIN( hi_max(jl), ph_i(ji,jl) + zdh ) 
     1007               ph_s(ji,jl) = MAX( 0._wp, ph_s(ji,jl) - zdh * rhoi * r1_rhos ) 
    9461008            ENDIF 
    9471009         END DO 
    9481010      END DO 
    9491011      ! 
     1012      ! == temperature and salinity == ! 
     1013      DO jl = 1, jpl 
     1014         pt_i (:,jl) = ptmi (:) 
     1015         pt_s (:,jl) = ptms (:) 
     1016         pt_su(:,jl) = ptmsu(:) 
     1017         ps_i (:,jl) = psmi (:) 
     1018         ps_i (:,jl) = psmi (:)          
     1019      END DO 
     1020      ! 
     1021      ! == ponds == ! 
     1022      ALLOCATE( zfra(idim) ) 
     1023      ! keep the same pond fraction atip/ati for each category 
     1024      WHERE( pati(:) /= 0._wp )   ;   zfra(:) = patip(:) / pati(:) 
     1025      ELSEWHERE                   ;   zfra(:) = 0._wp 
     1026      END WHERE 
     1027      DO jl = 1, jpl 
     1028         pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 
     1029      END DO 
     1030      ! keep the same v_ip/v_i ratio for each category 
     1031      WHERE( ( phti(:) * pati(:) ) /= 0._wp )   ;   zfra(:) = ( phtip(:) * patip(:) ) / ( phti(:) * pati(:) ) 
     1032      ELSEWHERE                                 ;   zfra(:) = 0._wp 
     1033      END WHERE 
     1034      DO jl = 1, jpl 
     1035         WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1036         ELSEWHERE                       ;   ph_ip(:,jl) = 0._wp 
     1037         END WHERE 
     1038      END DO 
     1039      DEALLOCATE( zfra ) 
     1040      ! 
    9501041   END SUBROUTINE ice_var_itd_1cMc 
    9511042 
    952    SUBROUTINE ice_var_itd_NcMc( zhti, zhts, zati, zh_i, zh_s, za_i ) 
     1043   SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
     1044      &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
    9531045      !!------------------------------------------------------------------- 
    9541046      !! 
     
    9711063      !!                      b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin) 
    9721064      !! 
    973       !! ** Arguments : zhti: N-cat ice thickness 
    974       !!                zhts: N-cat snow depth 
    975       !!                zati: N-cat ice concentration 
     1065      !! ** Arguments : phti: N-cat ice thickness 
     1066      !!                phts: N-cat snow depth 
     1067      !!                pati: N-cat ice concentration 
    9761068      !! 
    9771069      !! ** Output    : jpl-cat  
     
    9791071      !!  (Example of application: BDY forcings when inputs have N-cat /= jpl)   
    9801072      !!------------------------------------------------------------------- 
    981       INTEGER  ::   ji, jl, jl1, jl2             ! dummy loop indices 
     1073      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
     1074      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
     1075      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
     1076      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     1077      ! 
     1078      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   jlfil, jlfil2 
     1079      INTEGER , ALLOCATABLE, DIMENSION(:)   ::   jlmax, jlmin 
     1080      REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   z1_ai, z1_vi, z1_vs, ztmp, zfra 
     1081      ! 
     1082      REAL(wp), PARAMETER ::   ztrans = 0.25_wp 
     1083      INTEGER  ::   ji, jl, jl1, jl2 
    9821084      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 ) 
     1085      !!------------------------------------------------------------------- 
     1086      ! 
     1087      idim = SIZE( phti, 1 ) 
     1088      icat = SIZE( phti, 2 ) 
     1089      ! 
     1090      ! == thickness and concentration == ! 
    9921091      !                                 ! ---------------------- ! 
    9931092      IF( icat == jpl ) THEN            ! input cat = output cat ! 
    9941093         !                              ! ---------------------- ! 
    995          zh_i(:,:) = zhti(:,:) 
    996          zh_s(:,:) = zhts(:,:) 
    997          za_i(:,:) = zati(:,:) 
     1094         ph_i(:,:) = phti(:,:) 
     1095         ph_s(:,:) = phts(:,:) 
     1096         pa_i(:,:) = pati(:,:) 
     1097         ! 
     1098         ! == temperature and salinity and ponds == ! 
     1099         pt_i (:,:) = ptmi (:,:) 
     1100         pt_s (:,:) = ptms (:,:) 
     1101         pt_su(:,:) = ptmsu(:,:) 
     1102         ps_i (:,:) = psmi (:,:) 
     1103         pa_ip(:,:) = patip(:,:) 
     1104         ph_ip(:,:) = phtip(:,:) 
    9981105         !                              ! ---------------------- ! 
    9991106      ELSEIF( icat == 1 ) THEN          ! input cat = 1          ! 
    10001107         !                              ! ---------------------- ! 
    1001          CALL  ice_var_itd_1cMc( zhti(:,1), zhts(:,1), zati(:,1), zh_i(:,:), zh_s(:,:), za_i(:,:) ) 
     1108         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 
     1109            &                    ph_i(:,:), ph_s(:,:), pa_i (:,:), & 
     1110            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), & 
     1111            &                    pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:)  ) 
    10021112         !                              ! ---------------------- ! 
    10031113      ELSEIF( jpl == 1 ) THEN           ! output cat = 1         ! 
    10041114         !                              ! ---------------------- ! 
    1005          CALL  ice_var_itd_Nc1c( zhti(:,:), zhts(:,:), zati(:,:), zh_i(:,1), zh_s(:,1), za_i(:,1) )          
     1115         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 
     1116            &                    ph_i(:,1), ph_s(:,1), pa_i (:,1), & 
     1117            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), & 
     1118            &                    pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1)  ) 
    10061119         !                              ! ----------------------- ! 
    10071120      ELSE                              ! input cat /= output cat ! 
     
    10121125 
    10131126         ! --- 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 
     1127         ph_i(1:idim,1:jpl) = 0._wp 
     1128         ph_s(1:idim,1:jpl) = 0._wp 
     1129         pa_i(1:idim,1:jpl) = 0._wp 
    10171130         ! 
    10181131         ! --- fill the categories --- ! 
     
    10241137            DO jl2 = 1, icat 
    10251138               DO ji = 1, idim 
    1026                   IF( hi_max(jl1-1) <= zhti(ji,jl2) .AND. hi_max(jl1) > zhti(ji,jl2) ) THEN 
     1139                  IF( hi_max(jl1-1) <= phti(ji,jl2) .AND. hi_max(jl1) > phti(ji,jl2) ) THEN 
    10271140                     ! 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) 
     1141                     ph_i(ji,jl1) = phti(ji,jl2) 
     1142                     ph_s(ji,jl1) = phts(ji,jl2) 
     1143                     pa_i(ji,jl1) = pati(ji,jl2) 
    10311144                     ! record categories that are filled 
    10321145                     jlmax(ji) = MAX( jlmax(ji), jl1 ) 
     
    10451158            IF( jl1 > 1 ) THEN 
    10461159               ! 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) 
     1160               pa_i(ji,jl1-1) = ztrans * pa_i(ji,jl1) 
     1161               ph_i(ji,jl1-1) = hi_mean(jl1-1) 
    10491162               ! remove from cat jl1 
    1050                za_i(ji,jl1  ) = ( 1._wp - ztrans ) * za_i(ji,jl1) 
     1163               pa_i(ji,jl1  ) = ( 1._wp - ztrans ) * pa_i(ji,jl1) 
    10511164            ENDIF 
    10521165            IF( jl2 < jpl ) THEN 
    10531166               ! 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) 
     1167               pa_i(ji,jl2+1) = ztrans * pa_i(ji,jl2) 
     1168               ph_i(ji,jl2+1) = hi_mean(jl2+1) 
    10561169               ! remove from cat jl2 
    1057                za_i(ji,jl2  ) = ( 1._wp - ztrans ) * za_i(ji,jl2) 
     1170               pa_i(ji,jl2  ) = ( 1._wp - ztrans ) * pa_i(ji,jl2) 
    10581171            ENDIF 
    10591172         END DO 
     
    10651178               IF( jlfil(ji,jl-1) /= 0 .AND. jlfil(ji,jl) == 0 ) THEN 
    10661179                  ! fill high 
    1067                   za_i(ji,jl) = ztrans * za_i(ji,jl-1) 
    1068                   zh_i(ji,jl) = hi_mean(jl) 
     1180                  pa_i(ji,jl) = ztrans * pa_i(ji,jl-1) 
     1181                  ph_i(ji,jl) = hi_mean(jl) 
    10691182                  jlfil(ji,jl) = jl 
    10701183                  ! remove low 
    1071                   za_i(ji,jl-1) = ( 1._wp - ztrans ) * za_i(ji,jl-1) 
     1184                  pa_i(ji,jl-1) = ( 1._wp - ztrans ) * pa_i(ji,jl-1) 
    10721185               ENDIF 
    10731186            END DO 
     
    10791192               IF( jlfil2(ji,jl+1) /= 0 .AND. jlfil2(ji,jl) == 0 ) THEN 
    10801193                  ! 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)  
     1194                  pa_i(ji,jl) = pa_i(ji,jl) + ztrans * pa_i(ji,jl+1) 
     1195                  ph_i(ji,jl) = hi_mean(jl)  
    10831196                  jlfil2(ji,jl) = jl 
    10841197                  ! remove high 
    1085                   za_i(ji,jl+1) = ( 1._wp - ztrans ) * za_i(ji,jl+1) 
     1198                  pa_i(ji,jl+1) = ( 1._wp - ztrans ) * pa_i(ji,jl+1) 
    10861199               ENDIF 
    10871200            END DO 
     
    10901203         DEALLOCATE( jlfil, jlfil2 )      ! deallocate arrays 
    10911204         DEALLOCATE( jlmin, jlmax ) 
     1205         ! 
     1206         ! == temperature and salinity == ! 
     1207         ! 
     1208         ALLOCATE( z1_ai(idim), z1_vi(idim), z1_vs(idim), ztmp(idim) ) 
     1209         ! 
     1210         WHERE( SUM( pa_i(:,:), dim=2 ) /= 0._wp )               ;   z1_ai(:) = 1._wp / SUM( pa_i(:,:), dim=2 ) 
     1211         ELSEWHERE                                               ;   z1_ai(:) = 0._wp 
     1212         END WHERE 
     1213         WHERE( SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) /= 0._wp )   ;   z1_vi(:) = 1._wp / SUM( pa_i(:,:) * ph_i(:,:), dim=2 ) 
     1214         ELSEWHERE                                               ;   z1_vi(:) = 0._wp 
     1215         END WHERE 
     1216         WHERE( SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) /= 0._wp )   ;   z1_vs(:) = 1._wp / SUM( pa_i(:,:) * ph_s(:,:), dim=2 ) 
     1217         ELSEWHERE                                               ;   z1_vs(:) = 0._wp 
     1218         END WHERE 
     1219         ! 
     1220         ! fill all the categories with the same value 
     1221         ztmp(:) = SUM( ptmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 
     1222         DO jl = 1, jpl 
     1223            pt_i (:,jl) = ztmp(:) 
     1224         END DO 
     1225         ztmp(:) = SUM( ptms (:,:) * pati(:,:) * phts(:,:), dim=2 ) * z1_vs(:) 
     1226         DO jl = 1, jpl 
     1227            pt_s (:,jl) = ztmp(:) 
     1228         END DO 
     1229         ztmp(:) = SUM( ptmsu(:,:) * pati(:,:)            , dim=2 ) * z1_ai(:) 
     1230         DO jl = 1, jpl 
     1231            pt_su(:,jl) = ztmp(:) 
     1232         END DO 
     1233         ztmp(:) = SUM( psmi (:,:) * pati(:,:) * phti(:,:), dim=2 ) * z1_vi(:) 
     1234         DO jl = 1, jpl 
     1235            ps_i (:,jl) = ztmp(:) 
     1236         END DO 
     1237         ! 
     1238         DEALLOCATE( z1_ai, z1_vi, z1_vs, ztmp ) 
     1239         ! 
     1240         ! == ponds == ! 
     1241         ALLOCATE( zfra(idim) ) 
     1242         ! keep the same pond fraction atip/ati for each category 
     1243         WHERE( SUM( pati(:,:), dim=2 ) /= 0._wp )   ;   zfra(:) = SUM( patip(:,:), dim=2 ) / SUM( pati(:,:), dim=2 ) 
     1244         ELSEWHERE                                   ;   zfra(:) = 0._wp 
     1245         END WHERE 
     1246         DO jl = 1, jpl 
     1247            pa_ip(:,jl) = zfra(:) * pa_i(:,jl) 
     1248         END DO 
     1249         ! keep the same v_ip/v_i ratio for each category 
     1250         WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 
     1251            zfra(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 
     1252         ELSEWHERE 
     1253            zfra(:) = 0._wp 
     1254         END WHERE 
     1255         DO jl = 1, jpl 
     1256            WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_ip(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1257            ELSEWHERE                       ;   ph_ip(:,jl) = 0._wp 
     1258            END WHERE 
     1259         END DO 
     1260         DEALLOCATE( zfra ) 
    10921261         ! 
    10931262      ENDIF 
  • NEMO/trunk/src/ICE/icewri.F90

    r10911 r11536  
    5050      INTEGER  ::   ji, jj, jk, jl  ! dummy loop indices 
    5151      REAL(wp) ::   z2da, z2db, zrho1, zrho2 
    52       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d, zfast !  2D workspace 
     52      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios  
     53      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d, zfast                     ! 2D workspace 
    5354      REAL(wp), DIMENSION(jpi,jpj)     ::   zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask 
    5455      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zmsk00l, zmsksnl               ! cat masks 
     
    5859      REAL(wp) ::   zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh  
    5960      !!------------------------------------------------------------------- 
    60  
     61      ! 
    6162      IF( ln_timing )   CALL timing_start('icewri') 
     63 
     64      ! get missing value from xml 
     65      CALL iom_miss_val( 'icetemp', zmiss_val ) 
    6266 
    6367      ! brine volume 
     
    8589      ! Standard outputs 
    8690      !----------------- 
    87       zrho1 = ( rau0 - rhoi ) * r1_rau0; zrho2 = rhos * r1_rau0 
     91      zrho1 = ( rau0 - rhoi ) * r1_rau0 ; zrho2 = rhos * r1_rau0 
    8892      ! masks 
    89       IF( iom_use('icemask'  ) )   CALL iom_put( "icemask"  , zmsk00              )   ! ice mask 0% 
    90       IF( iom_use('icemask05') )   CALL iom_put( "icemask05", zmsk05              )   ! ice mask 5% 
    91       IF( iom_use('icemask15') )   CALL iom_put( "icemask15", zmsk15              )   ! ice mask 15% 
     93      CALL iom_put( 'icemask'  , zmsk00 )   ! ice mask 0% 
     94      CALL iom_put( 'icemask05', zmsk05 )   ! ice mask 5% 
     95      CALL iom_put( 'icemask15', zmsk15 )   ! ice mask 15% 
     96      CALL iom_put( 'icepres'  , zmsk00 )   ! Ice presence (1 or 0)  
    9297      ! 
    9398      ! general fields 
    94       IF( iom_use('icemass'  ) )   CALL iom_put( "icemass", rhoi * vt_i * zmsk00  )   ! Ice mass per cell area  
    95       IF( iom_use('snwmass'  ) )   CALL iom_put( "snwmass", rhos * vt_s * zmsksn  )   ! Snow mass per cell area 
    96       IF( iom_use('icepres'  ) )   CALL iom_put( "icepres", zmsk00                )   ! Ice presence (1 or 0)  
    97       IF( iom_use('iceconc'  ) )   CALL iom_put( "iceconc", at_i  * zmsk00        )   ! ice concentration 
    98       IF( iom_use('icevolu'  ) )   CALL iom_put( "icevolu", vt_i  * zmsk00        )   ! ice volume = mean ice thickness over the cell 
    99       IF( iom_use('icethic'  ) )   CALL iom_put( "icethic", hm_i  * zmsk00        )   ! ice thickness 
    100       IF( iom_use('snwthic'  ) )   CALL iom_put( "snwthic", hm_s  * zmsk00        )   ! snw thickness 
    101       IF( iom_use('icebrv'   ) )   CALL iom_put( "icebrv" , bvm_i * zmsk00 * 100. )   ! brine volume 
    102       IF( iom_use('iceage'   ) )   CALL iom_put( "iceage" , om_i  * zmsk15 / rday )   ! ice age 
    103       IF( iom_use('icehnew'  ) )   CALL iom_put( "icehnew", ht_i_new              )   ! new ice thickness formed in the leads 
    104       IF( iom_use('snwvolu'  ) )   CALL iom_put( "snwvolu", vt_s  * zmsksn        )   ! snow volume 
    105       IF( iom_use('icefrb') ) THEN 
     99      IF( iom_use('icemass' ) )   CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 )                                           ! Ice mass per cell area  
     100      IF( iom_use('snwmass' ) )   CALL iom_put( 'snwmass', vt_s * rhos * zmsksn )                                           ! Snow mass per cell area 
     101      IF( iom_use('iceconc' ) )   CALL iom_put( 'iceconc', at_i        * zmsk00 )                                           ! ice concentration 
     102      IF( iom_use('icevolu' ) )   CALL iom_put( 'icevolu', vt_i        * zmsk00 )                                           ! ice volume = mean ice thickness over the cell 
     103      IF( iom_use('icethic' ) )   CALL iom_put( 'icethic', hm_i        * zmsk00 )                                           ! ice thickness 
     104      IF( iom_use('snwthic' ) )   CALL iom_put( 'snwthic', hm_s        * zmsk00 )                                           ! snw thickness 
     105      IF( iom_use('icebrv'  ) )   CALL iom_put( 'icebrv' , bvm_i* 100. * zmsk00 )                                           ! brine volume 
     106      IF( iom_use('iceage'  ) )   CALL iom_put( 'iceage' , om_i / rday * zmsk15 + zmiss_val * ( 1._wp - zmsk15 ) )          ! ice age 
     107      IF( iom_use('icehnew' ) )   CALL iom_put( 'icehnew', ht_i_new             )                                           ! new ice thickness formed in the leads 
     108      IF( iom_use('snwvolu' ) )   CALL iom_put( 'snwvolu', vt_s        * zmsksn )                                           ! snow volume 
     109      IF( iom_use('icefrb'  ) ) THEN                                                                                        ! Ice freeboard 
    106110         z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) )                                          
    107111         WHERE( z2d < 0._wp )   z2d = 0._wp 
    108                                    CALL iom_put( "icefrb" , z2d * zmsk00          )   ! Ice freeboard 
     112                                  CALL iom_put( 'icefrb' , z2d * zmsk00         ) 
    109113      ENDIF 
    110     &