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.
limupdate1.F90 in branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90 @ 7963

Last change on this file since 7963 was 5870, checked in by acc, 9 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.
  • Property svn:keywords set to Id
File size: 10.5 KB
Line 
1MODULE limupdate1
2   !!======================================================================
3   !!                     ***  MODULE  limupdate1  ***
4   !!   LIM-3 : Update of sea-ice global variables at the end of the time step
5   !!======================================================================
6   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
7   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
8   !!----------------------------------------------------------------------
9#if defined key_lim3
10   !!----------------------------------------------------------------------
11   !!   'key_lim3'                                      LIM3 sea-ice model
12   !!----------------------------------------------------------------------
13   !!    lim_update1   : computes update of sea-ice global variables from trend terms
14   !!----------------------------------------------------------------------
15   USE sbc_oce         ! Surface boundary condition: ocean fields
16   USE sbc_ice         ! Surface boundary condition: ice fields
17   USE dom_ice
18   USE dom_oce
19   USE phycst          ! physical constants
20   USE ice
21   USE thd_ice         ! LIM thermodynamic sea-ice variables
22   USE limitd_th
23   USE limvar
24   USE prtctl          ! Print control
25   USE wrk_nemo        ! work arrays
26   USE timing          ! Timing
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
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC   lim_update1
36
37   !! * Substitutions
38#  include "vectopt_loop_substitute.h90"
39   !!----------------------------------------------------------------------
40   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
41   !! $Id$
42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
43   !!----------------------------------------------------------------------
44CONTAINS
45
46   SUBROUTINE lim_update1( kt )
47      !!-------------------------------------------------------------------
48      !!               ***  ROUTINE lim_update1  ***
49      !!               
50      !! ** Purpose :  Computes update of sea-ice global variables at
51      !!               the end of the dynamics.
52      !!               
53      !!---------------------------------------------------------------------
54      INTEGER, INTENT(in) ::   kt    ! number of iteration
55      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
56      REAL(wp) ::   zsal
57      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
58      !!-------------------------------------------------------------------
59      IF( nn_timing == 1 )  CALL timing_start('limupdate1')
60
61      IF( ln_limdyn ) THEN
62
63      IF( kt == nit000 .AND. lwp ) THEN
64         WRITE(numout,*) ' lim_update1 ' 
65         WRITE(numout,*) ' ~~~~~~~~~~~ '
66      ENDIF
67
68      ! conservation test
69      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
70
71      !----------------------------------------------------
72      ! ice concentration should not exceed amax
73      !-----------------------------------------------------
74      at_i(:,:) = 0._wp
75      DO jl = 1, jpl
76         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
77      END DO
78
79      DO jl  = 1, jpl
80         DO jj = 1, jpj
81            DO ji = 1, jpi
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) ) )
85               ENDIF
86            END DO
87         END DO
88      END DO
89   
90      !---------------------
91      ! Ice salinity bounds
92      !---------------------
93      IF (  nn_icesal == 2  ) THEN
94         DO jl = 1, jpl
95            DO jj = 1, jpj 
96               DO ji = 1, jpi
97                  zsal            = smv_i(ji,jj,jl)
98                  ! salinity stays in bounds
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) )
101                  ! associated salt flux
102                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
103               END DO
104            END DO
105         END DO
106      ENDIF
107
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
118      ! -------------------------------------------------
119      ! Diagnostics
120      ! -------------------------------------------------
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
137
138      ! conservation test
139      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
140
141      ! -------------------------------------------------
142      ! control prints
143      ! -------------------------------------------------
144      IF(ln_ctl) THEN   ! Control print
145         CALL prt_ctl_info(' ')
146         CALL prt_ctl_info(' - Cell values : ')
147         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
148         CALL prt_ctl(tab2d_1=e1e2t      , clinfo1=' lim_update1  : cell area   :')
149         CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update1  : at_i        :')
150         CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update1  : vt_i        :')
151         CALL prt_ctl(tab2d_1=vt_s       , clinfo1=' lim_update1  : vt_s        :')
152         CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update1  : strength    :')
153         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update1  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :')
154         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :')
155
156         DO jl = 1, jpl
157            CALL prt_ctl_info(' ')
158            CALL prt_ctl_info(' - Category : ', ivar1=jl)
159            CALL prt_ctl_info('   ~~~~~~~~~~')
160            CALL prt_ctl(tab2d_1=ht_i       (:,:,jl)        , clinfo1= ' lim_update1  : ht_i        : ')
161            CALL prt_ctl(tab2d_1=ht_s       (:,:,jl)        , clinfo1= ' lim_update1  : ht_s        : ')
162            CALL prt_ctl(tab2d_1=t_su       (:,:,jl)        , clinfo1= ' lim_update1  : t_su        : ')
163            CALL prt_ctl(tab2d_1=t_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : t_snow      : ')
164            CALL prt_ctl(tab2d_1=sm_i       (:,:,jl)        , clinfo1= ' lim_update1  : sm_i        : ')
165            CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update1  : o_i         : ')
166            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ')
167            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : a_i_b       : ')
168            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ')
169            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_i_b       : ')
170            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ')
171            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_s_b       : ')
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      : ')
176            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ')
177            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow_b    : ')
178            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ')
179            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update1  : smv_i_b     : ')
180            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ')
181            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update1  : oa_i_b      : ')
182
183            DO jk = 1, nlay_i
184               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
185               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_update1  : t_i       : ')
186            END DO
187         END DO
188
189         CALL prt_ctl_info(' ')
190         CALL prt_ctl_info(' - Heat / FW fluxes : ')
191         CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ')
192         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update1 : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ')
193
194         CALL prt_ctl_info(' ')
195         CALL prt_ctl_info(' - Stresses : ')
196         CALL prt_ctl_info('   ~~~~~~~~~~ ')
197         CALL prt_ctl(tab2d_1=utau       , clinfo1= ' lim_update1 : utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ')
198         CALL prt_ctl(tab2d_1=utau_ice   , clinfo1= ' lim_update1 : utau_ice  : ', tab2d_2=vtau_ice   , clinfo2= ' vtau_ice  : ')
199         CALL prt_ctl(tab2d_1=u_oce      , clinfo1= ' lim_update1 : u_oce     : ', tab2d_2=v_oce      , clinfo2= ' v_oce     : ')
200      ENDIF
201   
202      ENDIF ! ln_limdyn
203
204      IF( nn_timing == 1 )  CALL timing_stop('limupdate1')
205   END SUBROUTINE lim_update1
206#else
207   !!----------------------------------------------------------------------
208   !!   Default option         Empty Module               No sea-ice model
209   !!----------------------------------------------------------------------
210CONTAINS
211   SUBROUTINE lim_update1     ! Empty routine
212   END SUBROUTINE lim_update1
213
214#endif
215
216END MODULE limupdate1
Note: See TracBrowser for help on using the repository browser.