source: NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icecor.F90 @ 13140

Last change on this file since 13140 was 12546, checked in by orioltp, 12 months ago

Adding precision specification in hardcoded reals and other modifications to allow compilation without forcing reals without precision specification to a certain value through compiler flags

  • Property svn:keywords set to Id
File size: 10.1 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 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 "do_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      IF( ln_icediachk )   CALL ice_cons2D  (0, 'icecor',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation
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      !                             !-----------------------------------------------------
70      !                             !  ice thickness must exceed himin (for temp. diff.) !
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      !                             !-----------------------------------------------------
78      !                             !  ice concentration should not exceed amax          !
79      !                             !-----------------------------------------------------
80      at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
81      DO jl = 1, jpl
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]        !
87         !                          !-----------------------------------------------------
88         zzc = rhoi * r1_Dt_ice
89         DO jl = 1, jpl
90            DO_2D_11_11
91               zsal = sv_i(ji,jj,jl)
92               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)  )
93               sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux
94            END_2D
95         END DO
96      ENDIF
97      !                             !-----------------------------------------------------
98      !                             !  Rebin categories with thickness out of bounds     !
99      !                             !-----------------------------------------------------
100      IF ( jpl > 1 )   CALL ice_itd_reb( kt )
101
102      !                             !-----------------------------------------------------
103      CALL ice_var_zapsmall         !  Zap small values                                  !
104      !                             !-----------------------------------------------------
105
106      !                             !-----------------------------------------------------
107      IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values !
108         DO_2D_00_00
109            IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice
110               IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side
111               IF ( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side
112               IF ( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side
113               IF ( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side
114            ENDIF
115         END_2D
116         CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp )
117      ENDIF
118
119      !                             !-----------------------------------------------------
120      SELECT CASE( kn )             !  Diagnostics                                       !
121      !                             !-----------------------------------------------------
122      CASE( 1 )                        !--- dyn trend diagnostics
123         !
124         IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN
125            diag_heat(:,:) = - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice &      ! W.m-2
126               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice
127            diag_sice(:,:) =   SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi
128            diag_vice(:,:) =   SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi
129            diag_vsnw(:,:) =   SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhos
130         ENDIF
131         !                       ! concentration tendency (dynamics)
132         IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN
133            zafx(:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice 
134            CALL iom_put( 'afxdyn' , zafx )
135         ENDIF
136         !
137      CASE( 2 )                        !--- thermo trend diagnostics & ice aging
138         !
139         oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice   ! ice natural aging incrementation
140         !
141         IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN
142            diag_heat(:,:) = diag_heat(:,:) &
143               &             - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice &
144               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice
145            diag_sice(:,:) = diag_sice(:,:) &
146               &             + SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi
147            diag_vice(:,:) = diag_vice(:,:) &
148               &             + SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi
149            diag_vsnw(:,:) = diag_vsnw(:,:) &
150               &             + SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhos
151            CALL iom_put ( 'hfxdhc' , diag_heat ) 
152         ENDIF
153         !                       ! concentration tendency (total + thermo)
154         IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN
155            zafx(:,:) = zafx(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice
156            CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice )
157            CALL iom_put( 'afxtot' , zafx )
158         ENDIF
159         !
160      END SELECT
161      !
162      ! controls
163      IF( sn_cfctl%l_prtctl ) &
164         &                 CALL ice_prt3D   ('icecor')                                                             ! prints
165      IF( ln_icectl .AND. kn == 2 ) &
166         &                 CALL ice_prt     ( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                       ! prints
167      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
168      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icecor',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation
169      IF( ln_timing    )   CALL timing_stop ('icecor')                                                             ! timing
170      !
171   END SUBROUTINE ice_cor
172
173#else
174   !!----------------------------------------------------------------------
175   !!   Default option           Dummy module         NO SI3 sea-ice model
176   !!----------------------------------------------------------------------
177#endif
178
179   !!======================================================================
180END MODULE icecor
Note: See TracBrowser for help on using the repository browser.