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.
iceadv.F90 in branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/iceadv.F90 @ 8517

Last change on this file since 8517 was 8517, checked in by clem, 7 years ago

changes in style - part6 - one more round
File size: 8.7 KB
Line 
1MODULE iceadv
2   !!======================================================================
3   !!                       ***  MODULE iceadv   ***
4   !! LIM transport ice model : sea-ice advection/diffusion
5   !!======================================================================
6   !! History : LIM-2 ! 2000-01 (M.A. Morales Maqueda, H. Goosse, and T. Fichefet)  Original code
7   !!            3.0  ! 2005-11 (M. Vancoppenolle)   Multi-layer sea ice, salinity variations
8   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
9   !!----------------------------------------------------------------------
10#if defined key_lim3
11   !!----------------------------------------------------------------------
12   !!   'key_lim3'                                       LIM3 sea-ice model
13   !!----------------------------------------------------------------------
14   !!   ice_adv       : advection/diffusion process of sea ice
15   !!----------------------------------------------------------------------
16   USE phycst         ! physical constant
17   USE dom_oce        ! ocean domain
18   USE sbc_oce , ONLY : nn_fsbc   ! frequency of sea-ice call
19   USE ice            ! sea-ice: variables
20   USE icevar         ! sea-ice: operations
21   USE iceadv_prather ! sea-ice: advection scheme (Prather)
22   USE iceadv_umx     ! sea-ice: advection scheme (ultimate-macho)
23   USE icectl         ! sea-ice: control prints
24   !
25   USE in_out_manager ! I/O manager
26   USE lbclnk         ! lateral boundary conditions -- MPP exchanges
27   USE lib_mpp        ! MPP library
28   USE prtctl         ! Print control
29   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
30   USE timing         ! Timing
31   USE iom            !
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   ice_adv        ! called by icestp
37   PUBLIC   ice_adv_init   ! called by icestp
38
39   INTEGER ::              nice_adv   ! choice of the type of advection scheme
40   !                                        ! associated indices:
41   INTEGER, PARAMETER ::   np_advPRA = 1   ! Prather scheme
42   INTEGER, PARAMETER ::   np_advUMx = 2   ! Ultimate-Macho scheme
43
44   !! * Substitution
45#  include "vectopt_loop_substitute.h90"
46   !!----------------------------------------------------------------------
47   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
48   !! $Id: iceadv.F90 8373 2017-07-25 17:44:54Z clem $
49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
50   !!----------------------------------------------------------------------
51CONTAINS
52
53   SUBROUTINE ice_adv( kt ) 
54      !!----------------------------------------------------------------------
55      !!                   ***  ROUTINE ice_adv ***
56      !!                   
57      !! ** purpose : advection of sea ice
58      !!
59      !! ** method  : variables included in the process are scalar,   
60      !!     other values are considered as second order.
61      !!     For advection, one can choose between
62      !!     a) an Ultimate-Macho scheme (whose order is 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      IF( nn_timing == 1 )  CALL timing_start('iceadv')
70 
71      IF( kt == nit000 .AND. lwp ) THEN
72         WRITE(numout,*)
73         WRITE(numout,*) 'ice_adv: sea-ice advection'
74         WRITE(numout,*) '~~~~~~~'
75      ENDIF
76     
77      ! conservation test
78      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'iceadv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
79                     
80      !----------
81      ! Advection
82      !----------
83      SELECT CASE( nice_adv )
84      !                                !-----------------------!
85      CASE( np_advUMx )                ! ULTIMATE-MACHO scheme !
86         !                             !-----------------------!
87         CALL ice_adv_umx( kt, u_ice, v_ice,  &
88            &              ato_i, v_i, v_s, smv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )
89      !                                !-----------------------!
90      CASE( np_advPRA )                ! PRATHER scheme        !
91         !                             !-----------------------!
92         CALL ice_adv_prather( kt, u_ice, v_ice,  &
93            &                  ato_i, v_i, v_s, smv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )
94      END SELECT
95
96      !------------
97      ! diagnostics
98      !------------
99      diag_trp_ei (:,:) = SUM(SUM( e_i  (:,:,1:nlay_i,:) - e_i_b  (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice
100      diag_trp_es (:,:) = SUM(SUM( e_s  (:,:,1:nlay_s,:) - e_s_b  (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice
101      diag_trp_smv(:,:) = SUM(     smv_i(:,:,:)          - smv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice
102      diag_trp_vi (:,:) = SUM(     v_i  (:,:,:)          - v_i_b  (:,:,:)                  , dim=3 ) * r1_rdtice
103      diag_trp_vs (:,:) = SUM(     v_s  (:,:,:)          - v_s_b  (:,:,:)                  , dim=3 ) * r1_rdtice
104      IF( iom_use('icetrp') )   CALL iom_put( "icetrp" , diag_trp_vi * rday  )         ! ice volume transport
105      IF( iom_use('snwtrp') )   CALL iom_put( "snwtrp" , diag_trp_vs * rday  )         ! snw volume transport
106      IF( iom_use('saltrp') )   CALL iom_put( "saltrp" , diag_trp_smv * rday * rhoic ) ! salt content transport
107      IF( iom_use('deitrp') )   CALL iom_put( "deitrp" , diag_trp_ei         )         ! advected ice enthalpy (W/m2)
108      IF( iom_use('destrp') )   CALL iom_put( "destrp" , diag_trp_es         )         ! advected snw enthalpy (W/m2)
109               
110      ! controls
111      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'iceadv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
112      IF( ln_icectl      )   CALL ice_prt     (kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ')                       ! prints
113      IF( nn_timing == 1 )   CALL timing_stop ('iceadv')                                                             ! timing
114      !
115   END SUBROUTINE ice_adv
116
117
118   SUBROUTINE ice_adv_init
119      !!-------------------------------------------------------------------
120      !!                  ***  ROUTINE ice_adv_init  ***
121      !!
122      !! ** Purpose : Physical constants and parameters linked to the ice
123      !!      dynamics
124      !!
125      !! ** Method  :  Read the namice_adv namelist and check the ice-dynamic
126      !!       parameter values called at the first timestep (nit000)
127      !!
128      !! ** input   :   Namelist namice_adv
129      !!-------------------------------------------------------------------
130      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
131      !!
132      NAMELIST/namice_adv/ ln_adv_Pra, ln_adv_UMx, nn_UMx
133      !!-------------------------------------------------------------------
134      !
135      REWIND( numnam_ice_ref )         ! Namelist namice_adv in reference namelist : Ice dynamics
136      READ  ( numnam_ice_ref, namice_adv, IOSTAT = ios, ERR = 901)
137901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice_adv in reference namelist', lwp )
138      !
139      REWIND( numnam_ice_cfg )         ! Namelist namice_adv in configuration namelist : Ice dynamics
140      READ  ( numnam_ice_cfg, namice_adv, IOSTAT = ios, ERR = 902 )
141902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice_adv in configuration namelist', lwp )
142      IF(lwm) WRITE ( numoni, namice_adv )
143      !
144      IF(lwp) THEN                     ! control print
145         WRITE(numout,*)
146         WRITE(numout,*) 'ice_adv_init: ice parameters for ice dynamics '
147         WRITE(numout,*) '~~~~~~~~~~~~'
148         WRITE(numout,*) '   Namelist namice_adv'
149         WRITE(numout,*) '      type of advection scheme (Prather)                     ln_adv_Pra = ', ln_adv_Pra 
150         WRITE(numout,*) '      type of advection scheme (Ulimate-Macho)               ln_adv_UMx = ', ln_adv_UMx 
151         WRITE(numout,*) '         order of the Ultimate-Macho scheme                      nn_UMx = ', nn_UMx
152      ENDIF
153      !
154      !                             !== set the choice of ice advection ==!
155      ioptio = 0 
156      IF( ln_adv_Pra ) THEN   ;   ioptio = ioptio + 1   ;   nice_adv = np_advPRA    ;   ENDIF
157      IF( ln_adv_UMx ) THEN   ;   ioptio = ioptio + 1   ;   nice_adv = np_advUMx    ;   ENDIF
158      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_adv_init: choose one and only one ice advection scheme (ln_adv_Pra or ln_adv_UMx)' )
159      !
160   END SUBROUTINE ice_adv_init
161
162#else
163   !!----------------------------------------------------------------------
164   !!   Default option         Empty Module                No sea-ice model
165   !!----------------------------------------------------------------------
166#endif
167
168   !!======================================================================
169END MODULE iceadv
170
Note: See TracBrowser for help on using the repository browser.