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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 11082 for NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/ICE/icedyn_adv.F90 – NEMO

Ignore:
Timestamp:
2019-06-06T16:21:52+02:00 (5 years ago)
Author:
davestorkey
Message:

UKMO/NEMO_4.0_GO8_package : update to be relative to 11081 of NEMO_4.0_mirror.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/ICE/icedyn_adv.F90

    r10888 r11082  
    6464      !!---------------------------------------------------------------------- 
    6565      INTEGER, INTENT(in) ::   kt   ! number of iteration 
    66       ! 
    67       INTEGER ::   jl   ! dummy loop indice 
    68       REAL(wp), DIMENSION(jpi,jpj) ::   zmask  ! fraction of time step with v_i < 0 
    6966      !!--------------------------------------------------------------------- 
    7067      ! 
    71       IF( ln_timing )   CALL timing_start('icedyn_adv') 
     68      ! controls 
     69      IF( ln_timing    )   CALL timing_start('icedyn_adv')                                                             ! timing 
     70      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icedyn_adv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
    7271      ! 
    7372      IF( kt == nit000 .AND. lwp ) THEN 
     
    7675         WRITE(numout,*) '~~~~~~~~~~~' 
    7776      ENDIF 
    78        
    79       ! conservation test 
    80       IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icedyn_adv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
    81                       
    82       !---------- 
    83       ! Advection 
    84       !---------- 
     77      ! 
     78      !---------------! 
     79      !== Advection ==! 
     80      !---------------! 
    8581      SELECT CASE( nice_adv ) 
    8682      !                                !-----------------------! 
    8783      CASE( np_advUMx )                ! ULTIMATE-MACHO scheme ! 
    8884         !                             !-----------------------! 
    89          CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice, ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 
    90       !                                !-----------------------! 
     85         CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice, h_i, h_s, h_ip, & 
     86            &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 
     87         !                             !-----------------------! 
    9188      CASE( np_advPRA )                ! PRATHER scheme        ! 
    9289         !                             !-----------------------! 
    93          CALL ice_dyn_adv_pra(         kt, u_ice, v_ice, ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 
     90         CALL ice_dyn_adv_pra(         kt, u_ice, v_ice, & 
     91            &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 
    9492      END SELECT 
    95  
    96       !---------------------------- 
    97       ! Debug the advection schemes 
    98       !---------------------------- 
    99       ! clem: At least one advection scheme above is not strictly positive => UMx 
    100       !       In Prather, I am not sure if the fields are bounded by 0 or not (it seems yes) 
    101       !       In UMx    , advected fields are not perfectly bounded and negative values can appear. 
    102       !                   These values are usually very small but in some occasions they can also be non-negligible 
    103       !                   Therefore one needs to bound the advected fields by 0 (though this is not a clean fix) 
    104       ! 
    105       ! record the negative values resulting from UMx 
    106       zmask(:,:) = 0._wp ! keep the init to 0 here 
    107       DO jl = 1, jpl 
    108          WHERE( v_i(:,:,jl) < 0._wp )   zmask(:,:) = 1._wp 
    109       END DO 
    110       IF( iom_use('iceneg_pres') )   CALL iom_put("iceneg_pres", zmask                                      )  ! fraction of time step with v_i < 0 
    111       IF( iom_use('iceneg_volu') )   CALL iom_put("iceneg_volu", SUM(MIN( v_i, 0. ), dim=3 )                )  ! negative ice volume (only) 
    112       IF( iom_use('iceneg_hfx' ) )   CALL iom_put("iceneg_hfx" , ( SUM(SUM( MIN( e_i(:,:,1:nlay_i,:), 0. )  &  ! negative ice heat content (only) 
    113          &                                                                  , dim=4 ), dim=3 ) )* r1_rdtice )  ! -- eq. heat flux [W/m2] 
    114       ! 
    115       ! ==> conservation is ensured by calling this routine below, 
    116       !     however the global ice volume is then changed by advection (but errors are small)  
    117       CALL ice_var_zapneg( ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 
    11893 
    11994      !------------ 
Note: See TracChangeset for help on using the changeset viewer.