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 5621 for branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90 – NEMO

Ignore:
Timestamp:
2015-07-21T13:25:36+02:00 (9 years ago)
Author:
mathiot
Message:

UKMO_ISF: upgrade to NEMO_3.6_STABLE (r5554)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    • Property svn:keywords set to Id
    r5134 r5621  
    4141   !!---------------------------------------------------------------------- 
    4242   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    43    !! $Id: limupdate.F90 3294 2012-01-28 16:44:18Z rblod $ 
     43   !! $Id$ 
    4444   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 
     
    7272      ! Constrain the thickness of the smallest category above himin 
    7373      !---------------------------------------------------------------------- 
    74       CALL lim_var_glo2eqv 
    7574      DO jj = 1, jpj  
    7675         DO ji = 1, jpi 
     76            rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,1) - epsi20 ) )   !0 if no ice and 1 if yes 
     77            ht_i(ji,jj,1) = v_i (ji,jj,1) / MAX( a_i(ji,jj,1) , epsi20 ) * rswitch 
    7778            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN 
    78                a_i (ji,jj,1) = a_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin 
     79               a_i (ji,jj,1) = a_i (ji,jj,1) * ht_i(ji,jj,1) / rn_himin 
     80               oa_i(ji,jj,1) = oa_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin 
    7981            ENDIF 
    8082         END DO 
     
    9395            DO ji = 1, jpi 
    9496               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) ) ) 
     97                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
     98                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 
    9699               ENDIF 
    97100            END DO 
    98101         END DO 
    99102      END DO 
    100  
    101       !---------------------------------------------------- 
    102       ! Rebin categories with thickness out of bounds 
    103       !---------------------------------------------------- 
    104       IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 
    105  
    106       !----------------- 
    107       ! zap small values 
    108       !----------------- 
    109       CALL lim_var_zapsmall 
    110103 
    111104      !--------------------- 
     
    117110               DO ji = 1, jpi 
    118111                  zsal            = smv_i(ji,jj,jl) 
    119                   smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
    120112                  ! salinity stays in bounds 
    121113                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     
    127119         END DO 
    128120      ENDIF 
     121 
     122      !---------------------------------------------------- 
     123      ! Rebin categories with thickness out of bounds 
     124      !---------------------------------------------------- 
     125      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 
     126 
     127      !----------------- 
     128      ! zap small values 
     129      !----------------- 
     130      CALL lim_var_zapsmall 
    129131 
    130132      !------------------------------------------------------------------------------ 
     
    150152      v_ice(:,:) = v_ice(:,:) * vmask(:,:,1) 
    151153  
    152       ! for outputs 
    153       CALL lim_var_glo2eqv            ! equivalent variables (outputs) 
    154       CALL lim_var_agg(2)             ! aggregate ice thickness categories 
    155  
    156       ! conservation test 
    157       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    158  
    159154      ! ------------------------------------------------- 
    160155      ! Diagnostics 
    161156      ! ------------------------------------------------- 
    162157      DO jl  = 1, jpl 
     158         oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday   ! ice natural aging 
    163159         afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
    164160      END DO 
    165161      afx_tot = afx_thd + afx_dyn 
    166162 
    167       ! heat content variation (W.m-2) 
    168163      DO jj = 1, jpj 
    169164         DO ji = 1, jpi             
    170             diag_heat_dhc(ji,jj) = diag_heat_dhc(ji,jj) -  & 
    171                &                   ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
    172                &                     SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
    173                &                   ) * r1_rdtice    
    174          END DO 
    175       END DO 
     165            ! heat content variation (W.m-2) 
     166            diag_heat(ji,jj) = diag_heat(ji,jj) -  & 
     167               &               ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
     168               &                 SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
     169               &               ) * r1_rdtice    
     170            ! salt, volume 
     171            diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice 
     172            diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice 
     173            diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice 
     174         END DO 
     175      END DO 
     176 
     177      ! conservation test 
     178      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     179 
     180      ! necessary calls (at least for coupling) 
     181      CALL lim_var_glo2eqv 
     182      CALL lim_var_agg(2) 
    176183 
    177184      ! ------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.