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 5600 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90 – NEMO

Ignore:
Timestamp:
2015-07-15T17:46:12+02:00 (9 years ago)
Author:
andrewryan
Message:

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    • Property svn:keywords set to Id
    r5034 r5600  
    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 
     
    5439   !!---------------------------------------------------------------------- 
    5540   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    56    !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $ 
     41   !! $Id$ 
    5742   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5843   !!---------------------------------------------------------------------- 
    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) 
    8170 
    82       !----------------- 
    83       ! zap small values 
    84       !----------------- 
    85       CALL lim_itd_me_zapsmall 
    86  
    87       CALL lim_var_glo2eqv 
    88       
    8971      !---------------------------------------------------- 
    90       ! Rebin categories with thickness out of bounds 
    91       !---------------------------------------------------- 
    92       IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl) 
    93  
     72      ! ice concentration should not exceed amax  
     73      !----------------------------------------------------- 
    9474      at_i(:,:) = 0._wp 
    9575      DO jl = 1, jpl 
     
    9777      END DO 
    9878 
    99       !---------------------------------------------------- 
    100       ! ice concentration should not exceed amax  
    101       !----------------------------------------------------- 
    10279      DO jl  = 1, jpl 
    10380         DO jj = 1, jpj 
    10481            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) ) ) 
    107                   ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     82               IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     83                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
     84                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
    10885               ENDIF 
    10986            END DO 
    11087         END DO 
    11188      END DO 
    112  
    113       at_i(:,:) = 0._wp 
    114       DO jl = 1, jpl 
    115          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    116       END DO 
    11789     
    118       ! -------------------------------------- 
    119       ! Final thickness distribution rebinning 
    120       ! -------------------------------------- 
    121       IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 
    122  
    123       !----------------- 
    124       ! zap small values 
    125       !----------------- 
    126       CALL lim_itd_me_zapsmall 
    127  
    12890      !--------------------- 
    12991      ! Ice salinity bounds 
    13092      !--------------------- 
    131       IF (  num_sal == 2  ) THEN  
     93      IF (  nn_icesal == 2  ) THEN  
    13294         DO jl = 1, jpl 
    13395            DO jj = 1, jpj  
    13496               DO ji = 1, jpi 
    13597                  zsal            = smv_i(ji,jj,jl) 
    136                   smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
    13798                  ! 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) ) 
     99                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     100                  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) ) 
    140101                  ! associated salt flux 
    141102                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     
    145106      ENDIF 
    146107 
     108      !---------------------------------------------------- 
     109      ! Rebin categories with thickness out of bounds 
     110      !---------------------------------------------------- 
     111      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 
     112 
     113      !----------------- 
     114      ! zap small values 
     115      !----------------- 
     116      CALL lim_var_zapsmall 
     117 
    147118      ! ------------------------------------------------- 
    148119      ! Diagnostics 
    149120      ! ------------------------------------------------- 
    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(:,:,:) 
     121      DO jl  = 1, jpl 
     122         afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
     123      END DO 
     124 
     125      DO jj = 1, jpj 
     126         DO ji = 1, jpi             
     127            ! heat content variation (W.m-2) 
     128            diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
     129               &                   SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
     130               &                 ) * r1_rdtice 
     131            ! salt, volume 
     132            diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice 
     133            diag_vice(ji,jj) = SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice 
     134            diag_vsnw(ji,jj) = SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice 
     135         END DO 
     136      END DO 
    160137 
    161138      ! conservation test 
    162139      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    163140 
     141      ! ------------------------------------------------- 
     142      ! control prints 
     143      ! ------------------------------------------------- 
    164144      IF(ln_ctl) THEN   ! Control print 
    165145         CALL prt_ctl_info(' ') 
    166146         CALL prt_ctl_info(' - Cell values : ') 
    167147         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    168          CALL prt_ctl(tab2d_1=area       , clinfo1=' lim_update1  : cell area   :') 
     148         CALL prt_ctl(tab2d_1=e12t       , clinfo1=' lim_update1  : cell area   :') 
    169149         CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update1  : at_i        :') 
    170150         CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update1  : vt_i        :') 
     
    172152         CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update1  : strength    :') 
    173153         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 :') 
    175154         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    176155 
     
    187166            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ') 
    188167            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   : ') 
    190168            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ') 
    191169            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   : ') 
    193170            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ') 
    194171            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   : ') 
     172            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1        : ') 
     173            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_i1_b      : ') 
     174            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2        : ') 
     175            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)      , clinfo1= ' lim_update1  : e_i2_b      : ') 
    202176            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ') 
    203177            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   : ') 
    205178            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ') 
    206179            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 : ') 
    208180            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ') 
    209181            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  : ') 
    211182 
    212183            DO jk = 1, nlay_i 
Note: See TracChangeset for help on using the changeset viewer.