source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/iceerr1.F90 @ 8422

Last change on this file since 8422 was 8422, checked in by clem, 3 years ago

continue naming

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