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.
icedyn_adv.F90 in NEMO/trunk/src/ICE – NEMO

source: NEMO/trunk/src/ICE/icedyn_adv.F90 @ 9885

Last change on this file since 9885 was 9885, checked in by clem, 6 years ago

add melt ponds in BDY (very roughly)

File size: 9.7 KB
RevLine 
[8586]1MODULE icedyn_adv
2   !!======================================================================
3   !!                       ***  MODULE icedyn_adv   ***
[9604]4   !!   sea-ice: advection
[8586]5   !!======================================================================
[9604]6   !! History :  4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
[8586]7   !!----------------------------------------------------------------------
[9570]8#if defined key_si3
[8586]9   !!----------------------------------------------------------------------
[9570]10   !!   'key_si3'                                       SI3 sea-ice model
[8586]11   !!----------------------------------------------------------------------
12   !!   ice_dyn_adv   : advection of sea ice variables
13   !!----------------------------------------------------------------------
14   USE phycst         ! physical constant
15   USE dom_oce        ! ocean domain
16   USE sbc_oce , ONLY : nn_fsbc   ! frequency of sea-ice call
17   USE ice            ! sea-ice: variables
18   USE icevar         ! sea-ice: operations
19   USE icedyn_adv_pra ! sea-ice: advection scheme (Prather)
20   USE icedyn_adv_umx ! sea-ice: advection scheme (ultimate-macho)
21   USE icectl         ! sea-ice: control prints
22   !
23   USE in_out_manager ! I/O manager
24   USE iom            ! I/O manager library
25   USE lib_mpp        ! MPP library
26   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
27   USE timing         ! Timing
28   USE prtctl         ! Print control
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   ice_dyn_adv        ! called by icestp
34   PUBLIC   ice_dyn_adv_init   ! called by icedyn
35
36   INTEGER ::              nice_adv   ! choice of the type of advection scheme
37   !                                        ! associated indices:
38   INTEGER, PARAMETER ::   np_advPRA = 1   ! Prather scheme
39   INTEGER, PARAMETER ::   np_advUMx = 2   ! Ultimate-Macho scheme
40   !
41   ! ** namelist (namdyn_adv) **
42   LOGICAL ::   ln_adv_Pra   ! Prather        advection scheme
43   LOGICAL ::   ln_adv_UMx   ! Ultimate-Macho advection scheme
44   INTEGER ::   nn_UMx       ! order of the UMx advection scheme   
45   !
46   !! * Substitution
47#  include "vectopt_loop_substitute.h90"
48   !!----------------------------------------------------------------------
[9598]49   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
[8586]50   !! $Id: icedyn_adv.F90 8373 2017-07-25 17:44:54Z clem $
[9598]51   !! Software governed by the CeCILL licence     (./LICENSE)
[8586]52   !!----------------------------------------------------------------------
53CONTAINS
54
55   SUBROUTINE ice_dyn_adv( kt ) 
56      !!----------------------------------------------------------------------
57      !!                   ***  ROUTINE ice_dyn_adv ***
58      !!                   
59      !! ** purpose : advection of sea ice
60      !!
61      !! ** method  : One can choose between
62      !!     a) an Ultimate-Macho scheme (with order defined by nn_UMx) => ln_adv_UMx
63      !!     b) and a second order Prather scheme => ln_adv_Pra
64      !!
65      !! ** action :
66      !!----------------------------------------------------------------------
67      INTEGER, INTENT(in) ::   kt   ! number of iteration
68      !!---------------------------------------------------------------------
69      !
[9124]70      IF( ln_timing )   CALL timing_start('icedyn_adv')
[8586]71      !
72      IF( kt == nit000 .AND. lwp ) THEN
73         WRITE(numout,*)
74         WRITE(numout,*) 'ice_dyn_adv: sea-ice advection'
75         WRITE(numout,*) '~~~~~~~~~~~'
76      ENDIF
77     
78      ! conservation test
79      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icedyn_adv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
80                     
81      !----------
82      ! Advection
83      !----------
84      SELECT CASE( nice_adv )
85      !                                !-----------------------!
86      CASE( np_advUMx )                ! ULTIMATE-MACHO scheme !
87         !                             !-----------------------!
88         CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice,  &
89            &                  ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )
90      !                                !-----------------------!
91      CASE( np_advPRA )                ! PRATHER scheme        !
92         !                             !-----------------------!
93         CALL ice_dyn_adv_pra( kt, u_ice, v_ice,  &
94            &                  ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )
95      END SELECT
96
[9880]97      !----------------------------
98      ! Debug the advection schemes
99      !----------------------------
100      ! clem: The 2 advection schemes above are not strictly positive.
[9885]101      !       In Prather, advected fields are bounded by 0 (not anymore?) in the routine with a MAX(0,field) ==> likely conservation issues
[9880]102      !       In UMx    , advected fields are not bounded and negative values can appear.
103      !                   These values are usually very small but in some occasions they can also be non-negligible
104      !                   Therefore one needs to bound the advected fields by 0 (though this is not a clean fix)
105      ! ==> 1) remove negative ice areas and volumes (conservation is ensure)
106      CALL ice_var_zapsmall 
107      ! ==> 2) remove remaining negative advected fields (conservation is not preserved)
108      WHERE( v_s (:,:,:)   < 0._wp )   v_s (:,:,:)   = 0._wp
109      WHERE( sv_i(:,:,:)   < 0._wp )   sv_i(:,:,:)   = 0._wp
110      WHERE( e_i (:,:,:,:) < 0._wp )   e_i (:,:,:,:) = 0._wp
111      WHERE( e_s (:,:,:,:) < 0._wp )   e_s (:,:,:,:) = 0._wp
112
[8586]113      !------------
114      ! diagnostics
115      !------------
116      diag_trp_ei(:,:) = SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice
117      diag_trp_es(:,:) = SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice
118      diag_trp_sv(:,:) = SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice
119      diag_trp_vi(:,:) = SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice
120      diag_trp_vs(:,:) = SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice
[8884]121      IF( iom_use('icemtrp') )   CALL iom_put( "icemtrp" , diag_trp_vi * rhoic          )   ! ice mass transport
122      IF( iom_use('snwmtrp') )   CALL iom_put( "snwmtrp" , diag_trp_vs * rhosn          )   ! snw mass transport
123      IF( iom_use('salmtrp') )   CALL iom_put( "salmtrp" , diag_trp_sv * rhoic * 1.e-03 )   ! salt mass transport (kg/m2/s)
124      IF( iom_use('dihctrp') )   CALL iom_put( "dihctrp" , -diag_trp_ei                 )   ! advected ice heat content (W/m2)
125      IF( iom_use('dshctrp') )   CALL iom_put( "dshctrp" , -diag_trp_es                 )   ! advected snw heat content (W/m2)
[8586]126
127      ! controls
[9124]128      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icedyn_adv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
129      IF( ln_icectl    )   CALL ice_prt     (kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ')                           ! prints
130      IF( ln_timing    )   CALL timing_stop ('icedyn_adv')                                                             ! timing
[8586]131      !
132   END SUBROUTINE ice_dyn_adv
133
134
135   SUBROUTINE ice_dyn_adv_init
136      !!-------------------------------------------------------------------
137      !!                  ***  ROUTINE ice_dyn_adv_init  ***
138      !!
139      !! ** Purpose :   Physical constants and parameters linked to the ice
140      !!                dynamics
141      !!
142      !! ** Method  :   Read the namdyn_adv namelist and check the ice-dynamic
143      !!                parameter values called at the first timestep (nit000)
144      !!
145      !! ** input   :   Namelist namdyn_adv
146      !!-------------------------------------------------------------------
147      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
148      !!
149      NAMELIST/namdyn_adv/ ln_adv_Pra, ln_adv_UMx, nn_UMx
150      !!-------------------------------------------------------------------
151      !
152      REWIND( numnam_ice_ref )         ! Namelist namdyn_adv in reference namelist : Ice dynamics
153      READ  ( numnam_ice_ref, namdyn_adv, IOSTAT = ios, ERR = 901)
[9169]154901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp )
[8586]155      REWIND( numnam_ice_cfg )         ! Namelist namdyn_adv in configuration namelist : Ice dynamics
156      READ  ( numnam_ice_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 )
[9169]157902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp )
158      IF(lwm) WRITE( numoni, namdyn_adv )
[8586]159      !
160      IF(lwp) THEN                     ! control print
161         WRITE(numout,*)
162         WRITE(numout,*) 'ice_dyn_adv_init: ice parameters for ice dynamics '
163         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
164         WRITE(numout,*) '   Namelist namdyn_adv:'
165         WRITE(numout,*) '      type of advection scheme (Prather)             ln_adv_Pra = ', ln_adv_Pra 
166         WRITE(numout,*) '      type of advection scheme (Ulimate-Macho)       ln_adv_UMx = ', ln_adv_UMx 
167         WRITE(numout,*) '         order of the Ultimate-Macho scheme          nn_UMx     = ', nn_UMx
168      ENDIF
169      !
170      !                             !== set the choice of ice advection ==!
171      ioptio = 0 
172      IF( ln_adv_Pra ) THEN   ;   ioptio = ioptio + 1   ;   nice_adv = np_advPRA    ;   ENDIF
173      IF( ln_adv_UMx ) THEN   ;   ioptio = ioptio + 1   ;   nice_adv = np_advUMx    ;   ENDIF
174      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_dyn_adv_init: choose one and only one ice adv. scheme (ln_adv_Pra or ln_adv_UMx)' )
175      !
176      IF( ln_adv_Pra )   CALL adv_pra_init  !* read or initialize all required files
177      !
178   END SUBROUTINE ice_dyn_adv_init
179
180#else
181   !!----------------------------------------------------------------------
[9570]182   !!   Default option         Empty Module           NO SI3 sea-ice model
[8586]183   !!----------------------------------------------------------------------
184#endif
185
186   !!======================================================================
187END MODULE icedyn_adv
188
Note: See TracBrowser for help on using the repository browser.