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.
icecor.F90 in NEMO/branches/UKMO/NEMO_4.0_add_pond_lids_prints/src/ICE – NEMO

source: NEMO/branches/UKMO/NEMO_4.0_add_pond_lids_prints/src/ICE/icecor.F90 @ 12369

Last change on this file since 12369 was 12369, checked in by dancopsey, 4 years ago

Add print statements

File size: 10.8 KB
Line 
1MODULE icecor
2   !!======================================================================
3   !!                     ***  MODULE  icecor  ***
4   !!   sea-ice: Corrections on sea-ice 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   !!            4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
9   !!----------------------------------------------------------------------
10#if defined key_si3
11   !!----------------------------------------------------------------------
12   !!   'key_si3'                                       SI3 sea-ice model
13   !!----------------------------------------------------------------------
14   !!    ice_cor      : corrections on sea-ice variables
15   !!----------------------------------------------------------------------
16   USE dom_oce        ! ocean domain
17   USE phycst         ! physical constants
18   USE ice            ! sea-ice: variable
19   USE ice1D          ! sea-ice: thermodynamic sea-ice variables
20   USE iceitd         ! sea-ice: rebining
21   USE icevar         ! sea-ice: operations
22   USE icectl         ! sea-ice: control prints
23   !
24   USE in_out_manager ! I/O manager
25   USE iom            ! I/O manager library
26   USE lib_mpp        ! MPP library
27   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
28   USE lbclnk         ! lateral boundary conditions (or mpp links)
29   USE timing         ! Timing
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   ice_cor   ! called by icestp.F90
35
36   !! * Substitutions
37#  include "vectopt_loop_substitute.h90"
38   !!----------------------------------------------------------------------
39   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
40   !! $Id$
41   !! Software governed by the CeCILL license (see ./LICENSE)
42   !!----------------------------------------------------------------------
43CONTAINS
44
45   SUBROUTINE ice_cor( kt, kn )
46      !!----------------------------------------------------------------------
47      !!               ***  ROUTINE ice_cor  ***
48      !!               
49      !! ** Purpose :   Computes corrections on sea-ice global variables at
50      !!              the end of the dynamics (kn=1) and thermodynamics (kn=2)
51      !!----------------------------------------------------------------------
52      INTEGER, INTENT(in) ::   kt    ! number of iteration
53      INTEGER, INTENT(in) ::   kn    ! 1 = after dyn ; 2 = after thermo
54      !
55      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
56      REAL(wp) ::   zsal, zzc
57      REAL(wp), DIMENSION(jpi,jpj) ::   zafx   ! concentration trends diag
58      !!----------------------------------------------------------------------
59      ! controls
60      IF( ln_timing    )   CALL timing_start('icecor')                                                             ! timing
61      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
62      !
63      IF( kt == nit000 .AND. lwp .AND. kn == 2 ) THEN
64         WRITE(numout,*)
65         WRITE(numout,*) 'ice_cor:  correct sea ice variables if out of bounds ' 
66         WRITE(numout,*) '~~~~~~~'
67      ENDIF
68      !                             !-----------------------------------------------------
69      !                             !  ice thickness must exceed himin (for temp. diff.) !
70      !                             !-----------------------------------------------------
71      WHERE( a_i(:,:,:) >= epsi20 )   ;   h_i(:,:,:) = v_i(:,:,:) / a_i(:,:,:)
72      ELSEWHERE                       ;   h_i(:,:,:) = 0._wp
73      END WHERE
74      WHERE( h_i(:,:,:) < rn_himin )      a_i(:,:,:) = a_i(:,:,:) * h_i(:,:,:) / rn_himin
75      !
76      !                             !-----------------------------------------------------
77      !                             !  ice concentration should not exceed amax          !
78      !                             !-----------------------------------------------------
79      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
80      DO jl  = 1, jpl
81         WHERE( at_i(:,:) > rn_amax_2d(:,:) )   a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:)
82      END DO
83   
84      !                             !-----------------------------------------------------
85      IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        !
86      !                             !-----------------------------------------------------
87
88      WRITE(numout,*) 'icecor: sv_i before bounding = ',sv_i(3,4,1)
89
90         zzc = rhoi * r1_rdtice
91         DO jl = 1, jpl
92            DO jj = 1, jpj 
93               DO ji = 1, jpi
94                  zsal = sv_i(ji,jj,jl)
95                  sv_i(ji,jj,jl) = MIN(  MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl)  )
96                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux
97
98                  IF ( ji == 3 .AND. jj == 4 .AND. jl == 1 ) THEN
99                     WRITE(numout,*) 'icecor: zsal, v_i(ji,jj,jl), sv_i(ji,jj,jl) = ',zsal, v_i(ji,jj,jl), sv_i(ji,jj,jl)
100                  ENDIF
101               END DO
102            END DO
103         END DO
104      ENDIF
105
106
107      WRITE(numout,*) 'icecor before redist: v_i(42,26,1), a_i(42,26,1), h_i = ',v_i(42,26,1), ' ', a_i(42,26,1), ' ', v_i(42,26,1)/a_i(42,26,1)
108
109      !                             !-----------------------------------------------------
110      !                             !  Rebin categories with thickness out of bounds     !
111      !                             !-----------------------------------------------------
112      IF ( jpl > 1 )   CALL ice_itd_reb( kt )
113
114      WRITE(numout,*) 'icecor after redist: v_i(42,26,1), a_i(42,26,1), h_i = ',v_i(42,26,1), ' ', a_i(42,26,1), ' ', v_i(42,26,1)/a_i(42,26,1)
115
116      !                             !-----------------------------------------------------
117      CALL ice_var_zapsmall         !  Zap small values                                  !
118      !                             !-----------------------------------------------------
119
120      !                             !-----------------------------------------------------
121      IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values !
122         DO jj = 2, jpjm1           !-----------------------------------------------------
123            DO ji = 2, jpim1
124               IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice
125                  IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side
126                  IF ( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side
127                  IF ( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side
128                  IF ( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side
129               ENDIF
130            END DO
131         END DO
132         CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. )            ! lateral boundary conditions
133      ENDIF
134
135!!gm I guess the trends are only out on demand
136!!   So please, only do this is it exite an iom_use of on a these variables
137!!   furthermore, only allocate the diag_ arrays in this case
138!!   and do the iom_put here so that it is only a local allocation
139!!gm
140      !                             !-----------------------------------------------------
141      SELECT CASE( kn )             !  Diagnostics                                       !
142      !                             !-----------------------------------------------------
143      CASE( 1 )                        !--- dyn trend diagnostics
144         !
145!!gm   here I think the number of ice cat is too small to use a SUM instruction...
146         DO jj = 1, jpj
147            DO ji = 1, jpi           
148               !                 ! heat content variation (W.m-2)
149               diag_heat(ji,jj) = - (  SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) )    & 
150                  &                  + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_rdtice
151               !                 ! salt, volume
152               diag_sice(ji,jj) = SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_rdtice
153               diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_rdtice
154               diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_rdtice
155            END DO
156         END DO
157         !                       ! concentration tendency (dynamics)
158         zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
159         afx_tot(:,:) = zafx(:,:)
160         IF( iom_use('afxdyn') )   CALL iom_put( 'afxdyn' , zafx(:,:) )
161         !
162      CASE( 2 )                        !--- thermo trend diagnostics & ice aging
163         !
164         oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice   ! ice natural aging incrementation
165         !
166!!gm   here I think the number of ice cat is too small to use a SUM instruction...
167         DO jj = 1, jpj
168            DO ji = 1, jpi           
169               !                 ! heat content variation (W.m-2)
170               diag_heat(ji,jj) = diag_heat(ji,jj) - (  SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) )    & 
171                  &                                   + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_rdtice
172               !                 ! salt, volume
173               diag_sice(ji,jj) = diag_sice(ji,jj) + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_rdtice
174               diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_rdtice
175               diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_rdtice
176            END DO
177         END DO
178         !                       ! concentration tendency (total + thermo)
179         zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice
180         afx_tot(:,:) = afx_tot(:,:) + zafx(:,:)
181         IF( iom_use('afxthd') )   CALL iom_put( 'afxthd' , zafx(:,:) )
182         IF( iom_use('afxtot') )   CALL iom_put( 'afxtot' , afx_tot(:,:) )
183         !
184      END SELECT
185      !
186      ! controls
187      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
188      IF( ln_ctl         )   CALL ice_prt3D   ('icecor')                                                             ! prints
189      IF( ln_icectl .AND. kn == 2 )   CALL ice_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                   ! prints
190      IF( ln_timing      )   CALL timing_stop ('icecor')                                                             ! timing
191      !
192   END SUBROUTINE ice_cor
193
194#else
195   !!----------------------------------------------------------------------
196   !!   Default option           Dummy module         NO SI3 sea-ice model
197   !!----------------------------------------------------------------------
198#endif
199
200   !!======================================================================
201END MODULE icecor
Note: See TracBrowser for help on using the repository browser.