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 5123 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90 – NEMO

Ignore:
Timestamp:
2015-03-04T17:06:03+01:00 (9 years ago)
Author:
clem
Message:

major LIM3 cleaning + monocat capabilities + NEMO namelist-consistency; sette to follow

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    r4990 r5123  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code 
    7    !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
     7   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_lim3 
     
    1313   !!    lim_update1   : computes update of sea-ice global variables from trend terms 
    1414   !!---------------------------------------------------------------------- 
    15    USE limrhg          ! ice rheology 
    16  
    17    USE dom_oce 
    18    USE oce             ! dynamics and tracers variables 
    19    USE in_out_manager 
    2015   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2116   USE sbc_ice         ! Surface boundary condition: ice fields 
    2217   USE dom_ice 
     18   USE dom_oce 
    2319   USE phycst          ! physical constants 
    2420   USE ice 
    25    USE limdyn 
    26    USE limtrp 
    27    USE limthd 
    28    USE limsbc 
    29    USE limdiahsb 
    30    USE limwri 
    31    USE limrst 
    3221   USE thd_ice         ! LIM thermodynamic sea-ice variables 
    33    USE par_ice 
    3422   USE limitd_th 
    35    USE limitd_me 
    3623   USE limvar 
    37    USE prtctl           ! Print control 
    38    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    39    USE wrk_nemo         ! work arrays 
    40    USE lib_fortran     ! glob_sum 
    41    USE in_out_manager   ! I/O manager 
    42    USE iom              ! I/O manager 
    43    USE lib_mpp          ! MPP library 
     24   USE prtctl          ! Print control 
     25   USE wrk_nemo        ! work arrays 
    4426   USE timing          ! Timing 
    45    USE limcons        ! conservation tests 
     27   USE limcons         ! conservation tests 
     28   USE lib_mpp         ! MPP library 
     29   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     30   USE in_out_manager  ! I/O manager 
    4631 
    4732   IMPLICIT NONE 
    4833   PRIVATE 
    4934 
    50    PUBLIC   lim_update1   ! routine called by ice_step 
     35   PUBLIC   lim_update1 
    5136 
    5237   !! * Substitutions 
     
    5944CONTAINS 
    6045 
    61    SUBROUTINE lim_update1 
     46   SUBROUTINE lim_update1( kt ) 
    6247      !!------------------------------------------------------------------- 
    6348      !!               ***  ROUTINE lim_update1  *** 
     
    6752      !!                 
    6853      !!--------------------------------------------------------------------- 
     54      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    6955      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    70       INTEGER  ::   i_ice_switch 
    7156      REAL(wp) ::   zsal 
    72       ! 
    73       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     57      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7458      !!------------------------------------------------------------------- 
    7559      IF( nn_timing == 1 )  CALL timing_start('limupdate1') 
     
    7761      IF( ln_limdyn ) THEN  
    7862 
     63      IF( kt == nit000 .AND. lwp ) THEN 
     64         WRITE(numout,*) ' lim_update1 '  
     65         WRITE(numout,*) ' ~~~~~~~~~~~ ' 
     66      ENDIF 
     67 
    7968      ! conservation test 
    8069      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     
    8372      ! zap small values 
    8473      !----------------- 
    85       CALL lim_itd_me_zapsmall 
     74      CALL lim_var_zapsmall 
    8675 
    8776      CALL lim_var_glo2eqv 
     
    10392         DO jj = 1, jpj 
    10493            DO ji = 1, jpi 
    105                IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
    106                   a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 
     94               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     95                  a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
    10796                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    10897               ENDIF 
     
    124113      ! zap small values 
    125114      !----------------- 
    126       CALL lim_itd_me_zapsmall 
     115      CALL lim_var_zapsmall 
    127116 
    128117      !--------------------- 
    129118      ! Ice salinity bounds 
    130119      !--------------------- 
    131       IF (  num_sal == 2  ) THEN  
     120      IF (  nn_icesal == 2  ) THEN  
    132121         DO jl = 1, jpl 
    133122            DO jj = 1, jpj  
     
    136125                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
    137126                  ! salinity stays in bounds 
    138                   i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
    139                   smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
     127                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     128                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) ) 
    140129                  ! associated salt flux 
    141130                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     
    145134      ENDIF 
    146135 
    147       ! ------------------------------------------------- 
    148       ! Diagnostics 
    149       ! ------------------------------------------------- 
    150       d_u_ice_dyn(:,:)     = u_ice(:,:)     - u_ice_b(:,:) 
    151       d_v_ice_dyn(:,:)     = v_ice(:,:)     - v_ice_b(:,:) 
    152       d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - a_i_b  (:,:,:) 
    153       d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - v_s_b  (:,:,:)   
    154       d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - v_i_b  (:,:,:)    
    155       d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - e_s_b  (:,:,:,:)   
    156       d_e_i_trp  (:,:,1:nlay_i,:) = e_i  (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 
    157       d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - oa_i_b (:,:,:) 
    158       d_smv_i_trp(:,:,:)   = 0._wp 
    159       IF(  num_sal == 2  ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 
    160  
    161136      ! conservation test 
    162137      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    163138 
     139      ! ------------------------------------------------- 
     140      ! Diagnostics 
     141      ! ------------------------------------------------- 
     142      DO jl  = 1, jpl 
     143         afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
     144      END DO 
     145 
     146      ! heat content variation (W.m-2) 
     147      DO jj = 1, jpj 
     148         DO ji = 1, jpi             
     149            diag_heat_dhc(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
     150               &                       SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
     151               &                     ) * r1_rdtice    
     152         END DO 
     153      END DO 
     154 
     155      ! ------------------------------------------------- 
     156      ! control prints 
     157      ! ------------------------------------------------- 
    164158      IF(ln_ctl) THEN   ! Control print 
    165159         CALL prt_ctl_info(' ') 
    166160         CALL prt_ctl_info(' - Cell values : ') 
    167161         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    168          CALL prt_ctl(tab2d_1=area       , clinfo1=' lim_update1  : cell area   :') 
     162         CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update1  : cell area   :') 
    169163         CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update1  : at_i        :') 
    170164         CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update1  : vt_i        :') 
     
    172166         CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update1  : strength    :') 
    173167         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update1  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    174          CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update1  : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :') 
    175168         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    176169 
     
    187180            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ') 
    188181            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : a_i_b       : ') 
    189             CALL prt_ctl(tab2d_1=d_a_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_a_i_trp   : ') 
    190182            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ') 
    191183            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_i_b       : ') 
    192             CALL prt_ctl(tab2d_1=d_v_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_i_trp   : ') 
    193184            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ') 
    194185            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_s_b       : ') 
    195             CALL prt_ctl(tab2d_1=d_v_s_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_s_trp   : ') 
    196             CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1        : ') 
    197             CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1_b      : ') 
    198             CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : de_i1_trp   : ') 
    199             CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2        : ') 
    200             CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2_b      : ') 
    201             CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : de_i2_trp   : ') 
     186            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1        : ') 
     187            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1_b      : ') 
     188            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2        : ') 
     189            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2_b      : ') 
    202190            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ') 
    203191            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow_b    : ') 
    204             CALL prt_ctl(tab2d_1=d_e_s_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : d_e_s_trp   : ') 
    205192            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ') 
    206193            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update1  : smv_i_b     : ') 
    207             CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl)        , clinfo1= ' lim_update1  : d_smv_i_trp : ') 
    208194            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ') 
    209195            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update1  : oa_i_b      : ') 
    210             CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl)        , clinfo1= ' lim_update1  : d_oa_i_trp  : ') 
    211196 
    212197            DO jk = 1, nlay_i 
Note: See TracChangeset for help on using the changeset viewer.