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/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90 @ 8016

Last change on this file since 8016 was 8016, checked in by timgraham, 7 years ago

Delete some remaining "USE wrk_array" lines
  • Property svn:keywords set to Id
File size: 6.2 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_oce
18   USE phycst          ! physical constants
19   USE ice
20   USE thd_ice         ! LIM thermodynamic sea-ice variables
21   USE limitd_th
22   USE limvar
23   USE timing          ! Timing
24   USE limcons         ! conservation tests
25   USE limctl          ! control prints
26   USE lib_mpp         ! MPP library
27   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
28   USE in_out_manager  ! I/O manager
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   lim_update1
34
35   !! * Substitutions
36#  include "vectopt_loop_substitute.h90"
37   !!----------------------------------------------------------------------
38   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
39   !! $Id$
40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44   SUBROUTINE lim_update1( kt )
45      !!-------------------------------------------------------------------
46      !!               ***  ROUTINE lim_update1  ***
47      !!               
48      !! ** Purpose :  Computes update of sea-ice global variables at
49      !!               the end of the dynamics.
50      !!               
51      !!---------------------------------------------------------------------
52      INTEGER, INTENT(in) ::   kt    ! number of iteration
53      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
54      REAL(wp) ::   zsal
55      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
56      !!-------------------------------------------------------------------
57      IF( nn_timing == 1 )  CALL timing_start('limupdate1')
58
59      IF( kt == nit000 .AND. lwp ) THEN
60         WRITE(numout,*)'' 
61         WRITE(numout,*)' lim_update1 ' 
62         WRITE(numout,*)' ~~~~~~~~~~~ '
63      ENDIF
64
65      ! conservation test
66      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
67
68      !----------------------------------------------------
69      ! ice concentration should not exceed amax
70      !-----------------------------------------------------
71      at_i(:,:) = 0._wp
72      DO jl = 1, jpl
73         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
74      END DO
75
76      DO jl  = 1, jpl
77         DO jj = 1, jpj
78            DO ji = 1, jpi
79               IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN
80                  a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
81                  oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
82               ENDIF
83            END DO
84         END DO
85      END DO
86   
87      !---------------------
88      ! Ice salinity bounds
89      !---------------------
90      IF (  nn_icesal == 2  ) THEN
91         DO jl = 1, jpl
92            DO jj = 1, jpj 
93               DO ji = 1, jpi
94                  zsal            = smv_i(ji,jj,jl)
95                  ! salinity stays in bounds
96                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
97                  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) )
98                  ! associated salt flux
99                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
100               END DO
101            END DO
102         END DO
103      ENDIF
104
105      !----------------------------------------------------
106      ! Rebin categories with thickness out of bounds
107      !----------------------------------------------------
108      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)
109
110      !-----------------
111      ! zap small values
112      !-----------------
113      CALL lim_var_zapsmall
114
115      ! -------------------------------------------------
116      ! Diagnostics
117      ! -------------------------------------------------
118      DO jl  = 1, jpl
119         afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
120      END DO
121
122      DO jj = 1, jpj
123         DO ji = 1, jpi           
124            ! heat content variation (W.m-2)
125            diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  & 
126               &                   SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    &
127               &                 ) * r1_rdtice
128            ! salt, volume
129            diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
130            diag_vice(ji,jj) = SUM( v_i  (ji,jj,:) - v_i_b  (ji,jj,:) ) * rhoic * r1_rdtice
131            diag_vsnw(ji,jj) = SUM( v_s  (ji,jj,:) - v_s_b  (ji,jj,:) ) * rhosn * r1_rdtice
132         END DO
133      END DO
134
135      ! conservation test
136      IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
137
138      ! control prints
139      IF( ln_ctl )       CALL lim_prt3D( 'limupdate1' )
140   
141      IF( nn_timing == 1 )  CALL timing_stop('limupdate1')
142
143   END SUBROUTINE lim_update1
144
145#else
146   !!----------------------------------------------------------------------
147   !!   Default option         Empty Module               No sea-ice model
148   !!----------------------------------------------------------------------
149CONTAINS
150   SUBROUTINE lim_update1     ! Empty routine
151   END SUBROUTINE lim_update1
152
153#endif
154
155END MODULE limupdate1
Note: See TracBrowser for help on using the repository browser.