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
RevLine 
[8409]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   !!----------------------------------------------------------------------
[8486]12   !!   'key_lim3'                                       LIM3 sea-ice model
[8409]13   !!----------------------------------------------------------------------
[8486]14   !!   ice_adv       : advection/diffusion process of sea ice
[8409]15   !!----------------------------------------------------------------------
16   USE phycst         ! physical constant
17   USE dom_oce        ! ocean domain
[8486]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
[8409]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
[8500]31   USE iom            !
[8409]32
33   IMPLICIT NONE
34   PRIVATE
35
[8512]36   PUBLIC   ice_adv        ! called by icestp
37   PUBLIC   ice_adv_init   ! called by icestp
[8409]38
[8517]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
[8518]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   !
[8409]49   !! * Substitution
50#  include "vectopt_loop_substitute.h90"
51   !!----------------------------------------------------------------------
[8486]52   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
[8409]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 ) 
[8486]59      !!----------------------------------------------------------------------
[8409]60      !!                   ***  ROUTINE ice_adv ***
61      !!                   
[8504]62      !! ** purpose : advection of sea ice
[8409]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
[8512]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
[8409]69      !!
70      !! ** action :
[8486]71      !!----------------------------------------------------------------------
[8409]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
[8504]77         WRITE(numout,*)
[8512]78         WRITE(numout,*) 'ice_adv: sea-ice advection'
79         WRITE(numout,*) '~~~~~~~'
[8409]80      ENDIF
81     
82      ! conservation test
[8517]83      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'iceadv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
84                     
[8504]85      !----------
86      ! Advection
87      !----------
[8517]88      SELECT CASE( nice_adv )
89      !                                !-----------------------!
90      CASE( np_advUMx )                ! ULTIMATE-MACHO scheme !
91         !                             !-----------------------!
[8518]92         CALL ice_adv_umx( nn_UMx, kt, u_ice, v_ice,  &
[8504]93            &              ato_i, v_i, v_s, smv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )
[8517]94      !                                !-----------------------!
95      CASE( np_advPRA )                ! PRATHER scheme        !
96         !                             !-----------------------!
[8504]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 )
[8517]99      END SELECT
[8409]100
[8504]101      !------------
102      ! diagnostics
103      !------------
[8517]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
[8500]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)
[8518]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
[8517]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
[8409]123      !
124   END SUBROUTINE ice_adv
125
[8512]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      !!-------------------------------------------------------------------
[8517]139      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
[8512]140      !!
[8516]141      NAMELIST/namice_adv/ ln_adv_Pra, ln_adv_UMx, nn_UMx
[8512]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,*)
[8514]155         WRITE(numout,*) 'ice_adv_init: ice parameters for ice dynamics '
[8512]156         WRITE(numout,*) '~~~~~~~~~~~~'
157         WRITE(numout,*) '   Namelist namice_adv'
[8517]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
[8512]161      ENDIF
162      !
[8517]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)' )
[8512]168      !
[8518]169      IF( ln_adv_Pra )   CALL adv_pra_rst( 'READ' )  !* read or initialize all required files
170      !
[8512]171   END SUBROUTINE ice_adv_init
172
[8409]173#else
174   !!----------------------------------------------------------------------
175   !!   Default option         Empty Module                No sea-ice model
176   !!----------------------------------------------------------------------
177#endif
[8486]178
[8409]179   !!======================================================================
180END MODULE iceadv
181
Note: See TracBrowser for help on using the repository browser.