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/2019/fix_sn_cfctl_ticket2328/src/ICE – NEMO

source: NEMO/branches/2019/fix_sn_cfctl_ticket2328/src/ICE/icecor.F90 @ 11872

Last change on this file since 11872 was 11872, checked in by acc, 4 years ago

Branch 2019/fix_sn_cfctl_ticket2328. See #2328. Replacement of ln_ctl and activation of full functionality with
sn_cfctl structure. These changes rename structure components l_mppout and l_mpptop as l_prtctl and l_prttrc
and introduce l_glochk to activate former ln_ctl code in stpctl.F90 to perform global location of min and max
checks. Also added is l_allon which can be used to activate all output (much like the former ln_ctl). If l_allon
is .false. then l_config decides whether or not the suboptions are used.

   sn_cfctl%l_glochk = .FALSE.    ! Range sanity checks are local (F) or global (T). Set T for debugging only
   sn_cfctl%l_allon  = .FALSE.    ! IF T activate all options. If F deactivate all unless l_config is T
   sn_cfctl%l_config = .TRUE.     ! IF .true. then control which reports are written with the remaining options

Note, these changes pass SETTE tests but all references to ln_ctl need to be removed from the sette scripts.

  • Property svn:keywords set to Id
File size: 10.3 KB
RevLine 
[8586]1MODULE icecor
2   !!======================================================================
3   !!                     ***  MODULE  icecor  ***
[9604]4   !!   sea-ice: Corrections on sea-ice variables at the end of the time step
[8586]5   !!======================================================================
6   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
7   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning
[9604]8   !!            4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
[8586]9   !!----------------------------------------------------------------------
[9570]10#if defined key_si3
[8586]11   !!----------------------------------------------------------------------
[9570]12   !!   'key_si3'                                       SI3 sea-ice model
[8586]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
[11536]19   USE ice1D          ! sea-ice: thermodynamic variables
[8586]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   !!----------------------------------------------------------------------
[9598]39   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
[10069]40   !! $Id$
[10068]41   !! Software governed by the CeCILL license (see ./LICENSE)
[8586]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
[9124]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
[11536]62      IF( ln_icediachk )   CALL ice_cons2D  (0, 'icecor',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation
[8586]63      !
64      IF( kt == nit000 .AND. lwp .AND. kn == 2 ) THEN
65         WRITE(numout,*)
66         WRITE(numout,*) 'ice_cor:  correct sea ice variables if out of bounds ' 
67         WRITE(numout,*) '~~~~~~~'
68      ENDIF
69      !                             !-----------------------------------------------------
[10994]70      !                             !  ice thickness must exceed himin (for temp. diff.) !
[9415]71      !                             !-----------------------------------------------------
72      WHERE( a_i(:,:,:) >= epsi20 )   ;   h_i(:,:,:) = v_i(:,:,:) / a_i(:,:,:)
73      ELSEWHERE                       ;   h_i(:,:,:) = 0._wp
74      END WHERE
75      WHERE( h_i(:,:,:) < rn_himin )      a_i(:,:,:) = a_i(:,:,:) * h_i(:,:,:) / rn_himin
76      !
77      !                             !-----------------------------------------------------
[8586]78      !                             !  ice concentration should not exceed amax          !
79      !                             !-----------------------------------------------------
80      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
[11536]81      DO jl = 1, jpl
[8586]82         WHERE( at_i(:,:) > rn_amax_2d(:,:) )   a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:)
83      END DO
84   
85      !                             !-----------------------------------------------------
86      IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        !
[11536]87         !                          !-----------------------------------------------------
[9935]88         zzc = rhoi * r1_rdtice
[8586]89         DO jl = 1, jpl
90            DO jj = 1, jpj 
91               DO ji = 1, jpi
92                  zsal = sv_i(ji,jj,jl)
93                  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)  )
94                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux
95               END DO
96            END DO
97         END DO
98      ENDIF
99      !                             !-----------------------------------------------------
100      !                             !  Rebin categories with thickness out of bounds     !
101      !                             !-----------------------------------------------------
102      IF ( jpl > 1 )   CALL ice_itd_reb( kt )
103
104      !                             !-----------------------------------------------------
105      CALL ice_var_zapsmall         !  Zap small values                                  !
106      !                             !-----------------------------------------------------
107
108      !                             !-----------------------------------------------------
109      IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values !
110         DO jj = 2, jpjm1           !-----------------------------------------------------
111            DO ji = 2, jpim1
112               IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice
113                  IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side
114                  IF ( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side
115                  IF ( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side
116                  IF ( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side
117               ENDIF
118            END DO
119         END DO
[11536]120         CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. )
[8586]121      ENDIF
122
123      !                             !-----------------------------------------------------
124      SELECT CASE( kn )             !  Diagnostics                                       !
125      !                             !-----------------------------------------------------
126      CASE( 1 )                        !--- dyn trend diagnostics
127         !
[11536]128         IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN
129            diag_heat(:,:) = - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice &      ! W.m-2
130               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice
131            diag_sice(:,:) =   SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice * rhoi
132            diag_vice(:,:) =   SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhoi
133            diag_vsnw(:,:) =   SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhos
134         ENDIF
[8586]135         !                       ! concentration tendency (dynamics)
[11536]136         IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN
137            zafx(:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
138            CALL iom_put( 'afxdyn' , zafx )
139         ENDIF
[8586]140         !
141      CASE( 2 )                        !--- thermo trend diagnostics & ice aging
142         !
143         oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice   ! ice natural aging incrementation
144         !
[11536]145         IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN
146            diag_heat(:,:) = diag_heat(:,:) &
147               &             - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice &
148               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice
149            diag_sice(:,:) = diag_sice(:,:) &
150               &             + SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice * rhoi
151            diag_vice(:,:) = diag_vice(:,:) &
152               &             + SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhoi
153            diag_vsnw(:,:) = diag_vsnw(:,:) &
154               &             + SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhos
155            CALL iom_put ( 'hfxdhc' , diag_heat ) 
156         ENDIF
[8586]157         !                       ! concentration tendency (total + thermo)
[11536]158         IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN
159            zafx(:,:) = zafx(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice
160            CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice )
161            CALL iom_put( 'afxtot' , zafx )
162         ENDIF
[8586]163         !
164      END SELECT
165      !
166      ! controls
[11872]167      IF( sn_cfctl%l_prtctl ) &
[11869]168         &                 CALL ice_prt3D   ('icecor')                                                             ! prints
[11536]169      IF( ln_icectl .AND. kn == 2 ) &
170         &                 CALL ice_prt     ( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                       ! prints
171      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
172      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icecor',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation
173      IF( ln_timing    )   CALL timing_stop ('icecor')                                                             ! timing
[8586]174      !
175   END SUBROUTINE ice_cor
176
177#else
178   !!----------------------------------------------------------------------
[9570]179   !!   Default option           Dummy module         NO SI3 sea-ice model
[8586]180   !!----------------------------------------------------------------------
181#endif
182
183   !!======================================================================
184END MODULE icecor
Note: See TracBrowser for help on using the repository browser.