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 @ 8518

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

changes in style - part6 - commits of the day
File size: 9.2 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   ! ** namelist (namice_adv) **
45   LOGICAL ::   ln_adv_Pra   ! Prather        advection scheme
46   LOGICAL ::   ln_adv_UMx   ! Ultimate-Macho advection scheme
47   INTEGER ::   nn_UMx       ! order of the UMx advection scheme   
48   !
49   !! * Substitution
50#  include "vectopt_loop_substitute.h90"
51   !!----------------------------------------------------------------------
52   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
53   !! $Id: iceadv.F90 8373 2017-07-25 17:44:54Z clem $
54   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
55   !!----------------------------------------------------------------------
56CONTAINS
57
58   SUBROUTINE ice_adv( kt ) 
59      !!----------------------------------------------------------------------
60      !!                   ***  ROUTINE ice_adv ***
61      !!                   
62      !! ** purpose : advection of sea ice
63      !!
64      !! ** method  : variables included in the process are scalar,   
65      !!     other values are considered as second order.
66      !!     For advection, one can choose between
67      !!     a) an Ultimate-Macho scheme (whose order is defined by nn_UMx) => ln_adv_UMx
68      !!     b) and a second order Prather scheme => ln_adv_Pra
69      !!
70      !! ** action :
71      !!----------------------------------------------------------------------
72      INTEGER, INTENT(in) ::   kt   ! number of iteration
73      !!---------------------------------------------------------------------
74      IF( nn_timing == 1 )  CALL timing_start('iceadv')
75 
76      IF( kt == nit000 .AND. lwp ) THEN
77         WRITE(numout,*)
78         WRITE(numout,*) 'ice_adv: sea-ice advection'
79         WRITE(numout,*) '~~~~~~~'
80      ENDIF
81     
82      ! conservation test
83      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'iceadv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
84                     
85      !----------
86      ! Advection
87      !----------
88      SELECT CASE( nice_adv )
89      !                                !-----------------------!
90      CASE( np_advUMx )                ! ULTIMATE-MACHO scheme !
91         !                             !-----------------------!
92         CALL ice_adv_umx( nn_UMx, 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      !                                !-----------------------!
95      CASE( np_advPRA )                ! PRATHER scheme        !
96         !                             !-----------------------!
97         CALL ice_adv_prather( kt, u_ice, v_ice,  &
98            &                  ato_i, v_i, v_s, smv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )
99      END SELECT
100
101      !------------
102      ! diagnostics
103      !------------
104      diag_trp_ei (:,:) = SUM(SUM( e_i  (:,:,1:nlay_i,:) - e_i_b  (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice
105      diag_trp_es (:,:) = SUM(SUM( e_s  (:,:,1:nlay_s,:) - e_s_b  (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice
106      diag_trp_smv(:,:) = SUM(     smv_i(:,:,:)          - smv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice
107      diag_trp_vi (:,:) = SUM(     v_i  (:,:,:)          - v_i_b  (:,:,:)                  , dim=3 ) * r1_rdtice
108      diag_trp_vs (:,:) = SUM(     v_s  (:,:,:)          - v_s_b  (:,:,:)                  , dim=3 ) * r1_rdtice
109      IF( iom_use('icetrp') )   CALL iom_put( "icetrp" , diag_trp_vi * rday  )         ! ice volume transport
110      IF( iom_use('snwtrp') )   CALL iom_put( "snwtrp" , diag_trp_vs * rday  )         ! snw volume transport
111      IF( iom_use('saltrp') )   CALL iom_put( "saltrp" , diag_trp_smv * rday * rhoic ) ! salt content transport
112      IF( iom_use('deitrp') )   CALL iom_put( "deitrp" , diag_trp_ei         )         ! advected ice enthalpy (W/m2)
113      IF( iom_use('destrp') )   CALL iom_put( "destrp" , diag_trp_es         )         ! advected snw enthalpy (W/m2)
114
115      IF( lrst_ice ) THEN                       !* write Prather fields in the restart file
116         IF( ln_adv_Pra )   CALL adv_pra_rst( 'WRITE', kt )
117      ENDIF
118               
119      ! controls
120      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'iceadv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
121      IF( ln_icectl      )   CALL ice_prt     (kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ')                       ! prints
122      IF( nn_timing == 1 )   CALL timing_stop ('iceadv')                                                             ! timing
123      !
124   END SUBROUTINE ice_adv
125
126
127   SUBROUTINE ice_adv_init
128      !!-------------------------------------------------------------------
129      !!                  ***  ROUTINE ice_adv_init  ***
130      !!
131      !! ** Purpose : Physical constants and parameters linked to the ice
132      !!      dynamics
133      !!
134      !! ** Method  :  Read the namice_adv namelist and check the ice-dynamic
135      !!       parameter values called at the first timestep (nit000)
136      !!
137      !! ** input   :   Namelist namice_adv
138      !!-------------------------------------------------------------------
139      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
140      !!
141      NAMELIST/namice_adv/ ln_adv_Pra, ln_adv_UMx, nn_UMx
142      !!-------------------------------------------------------------------
143      !
144      REWIND( numnam_ice_ref )         ! Namelist namice_adv in reference namelist : Ice dynamics
145      READ  ( numnam_ice_ref, namice_adv, IOSTAT = ios, ERR = 901)
146901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice_adv in reference namelist', lwp )
147      !
148      REWIND( numnam_ice_cfg )         ! Namelist namice_adv in configuration namelist : Ice dynamics
149      READ  ( numnam_ice_cfg, namice_adv, IOSTAT = ios, ERR = 902 )
150902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namice_adv in configuration namelist', lwp )
151      IF(lwm) WRITE ( numoni, namice_adv )
152      !
153      IF(lwp) THEN                     ! control print
154         WRITE(numout,*)
155         WRITE(numout,*) 'ice_adv_init: ice parameters for ice dynamics '
156         WRITE(numout,*) '~~~~~~~~~~~~'
157         WRITE(numout,*) '   Namelist namice_adv'
158         WRITE(numout,*) '      type of advection scheme (Prather)                     ln_adv_Pra = ', ln_adv_Pra 
159         WRITE(numout,*) '      type of advection scheme (Ulimate-Macho)               ln_adv_UMx = ', ln_adv_UMx 
160         WRITE(numout,*) '         order of the Ultimate-Macho scheme                      nn_UMx = ', nn_UMx
161      ENDIF
162      !
163      !                             !== set the choice of ice advection ==!
164      ioptio = 0 
165      IF( ln_adv_Pra ) THEN   ;   ioptio = ioptio + 1   ;   nice_adv = np_advPRA    ;   ENDIF
166      IF( ln_adv_UMx ) THEN   ;   ioptio = ioptio + 1   ;   nice_adv = np_advUMx    ;   ENDIF
167      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_adv_init: choose one and only one ice advection scheme (ln_adv_Pra or ln_adv_UMx)' )
168      !
169      IF( ln_adv_Pra )   CALL adv_pra_rst( 'READ' )  !* read or initialize all required files
170      !
171   END SUBROUTINE ice_adv_init
172
173#else
174   !!----------------------------------------------------------------------
175   !!   Default option         Empty Module                No sea-ice model
176   !!----------------------------------------------------------------------
177#endif
178
179   !!======================================================================
180END MODULE iceadv
181
Note: See TracBrowser for help on using the repository browser.