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

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv.F90 @ 8554

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

changes in style - part6 - pure cosmetics

File size: 9.1 KB
RevLine 
[8534]1MODULE icedyn_adv
2   !!======================================================================
3   !!                       ***  MODULE icedyn_adv   ***
4   !!   ESIM : sea-ice advection
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'                                       ESIM sea-ice model
13   !!----------------------------------------------------------------------
14   !!   ice_dyn_adv   : advection of sea ice variables
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 icedyn_adv_pra ! sea-ice: advection scheme (Prather)
22   USE icedyn_adv_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 iom            ! I/O manager library
27   USE lib_mpp        ! MPP library
28   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
29   USE timing         ! Timing
30   USE prtctl         ! Print control
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC   ice_dyn_adv        ! called by icestp
36   PUBLIC   ice_dyn_adv_init   ! called by icedyn
37
38   INTEGER ::              nice_adv   ! choice of the type of advection scheme
39   !                                        ! associated indices:
40   INTEGER, PARAMETER ::   np_advPRA = 1   ! Prather scheme
41   INTEGER, PARAMETER ::   np_advUMx = 2   ! Ultimate-Macho scheme
42   !
43   ! ** namelist (namdyn_adv) **
44   LOGICAL ::   ln_adv_Pra   ! Prather        advection scheme
45   LOGICAL ::   ln_adv_UMx   ! Ultimate-Macho advection scheme
46   INTEGER ::   nn_UMx       ! order of the UMx advection scheme   
47   !
48   !! * Substitution
49#  include "vectopt_loop_substitute.h90"
50   !!----------------------------------------------------------------------
51   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
52   !! $Id: icedyn_adv.F90 8373 2017-07-25 17:44:54Z clem $
53   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
54   !!----------------------------------------------------------------------
55CONTAINS
56
57   SUBROUTINE ice_dyn_adv( kt ) 
58      !!----------------------------------------------------------------------
59      !!                   ***  ROUTINE ice_dyn_adv ***
60      !!                   
61      !! ** purpose : advection of sea ice
62      !!
63      !! ** method  : One can choose between
64      !!     a) an Ultimate-Macho scheme (with order defined by nn_UMx) => ln_adv_UMx
65      !!     b) and a second order Prather scheme => ln_adv_Pra
66      !!
67      !! ** action :
68      !!----------------------------------------------------------------------
69      INTEGER, INTENT(in) ::   kt   ! number of iteration
70      !!---------------------------------------------------------------------
71      !
72      IF( nn_timing == 1 )  CALL timing_start('icedyn_adv')
73      !
74      IF( kt == nit000 .AND. lwp ) THEN
75         WRITE(numout,*)
76         WRITE(numout,*) 'ice_dyn_adv: sea-ice advection'
77         WRITE(numout,*) '~~~~~~~~~~~'
78      ENDIF
79     
80      ! conservation test
81      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icedyn_adv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
82                     
83      !----------
84      ! Advection
85      !----------
86      SELECT CASE( nice_adv )
87      !                                !-----------------------!
88      CASE( np_advUMx )                ! ULTIMATE-MACHO scheme !
89         !                             !-----------------------!
90         CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice,  &
91            &                  ato_i, v_i, v_s, smv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )
92      !                                !-----------------------!
93      CASE( np_advPRA )                ! PRATHER scheme        !
94         !                             !-----------------------!
95         CALL ice_dyn_adv_pra( kt, u_ice, v_ice,  &
96            &                  ato_i, v_i, v_s, smv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i )
97      END SELECT
98
99      !------------
100      ! diagnostics
101      !------------
102      diag_trp_ei (:,:) = SUM(SUM( e_i  (:,:,1:nlay_i,:) - e_i_b  (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice
103      diag_trp_es (:,:) = SUM(SUM( e_s  (:,:,1:nlay_s,:) - e_s_b  (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice
104      diag_trp_smv(:,:) = SUM(     smv_i(:,:,:)          - smv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice
105      diag_trp_vi (:,:) = SUM(     v_i  (:,:,:)          - v_i_b  (:,:,:)                  , dim=3 ) * r1_rdtice
106      diag_trp_vs (:,:) = SUM(     v_s  (:,:,:)          - v_s_b  (:,:,:)                  , dim=3 ) * r1_rdtice
107      IF( iom_use('icetrp') )   CALL iom_put( "icetrp" , diag_trp_vi * rday  )         ! ice volume transport
108      IF( iom_use('snwtrp') )   CALL iom_put( "snwtrp" , diag_trp_vs * rday  )         ! snw volume transport
109      IF( iom_use('saltrp') )   CALL iom_put( "saltrp" , diag_trp_smv * rday * rhoic ) ! salt content transport
110      IF( iom_use('deitrp') )   CALL iom_put( "deitrp" , diag_trp_ei         )         ! advected ice enthalpy (W/m2)
111      IF( iom_use('destrp') )   CALL iom_put( "destrp" , diag_trp_es         )         ! advected snw enthalpy (W/m2)
112
113      IF( lrst_ice ) THEN                       !* write Prather fields in the restart file
114         IF( ln_adv_Pra )   CALL adv_pra_rst( 'WRITE', kt )
115      ENDIF
116               
117      ! controls
118      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icedyn_adv', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
119      IF( ln_icectl      )   CALL ice_prt     (kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ')                           ! prints
120      IF( nn_timing == 1 )   CALL timing_stop ('icedyn_adv')                                                             ! timing
121      !
122   END SUBROUTINE ice_dyn_adv
123
124
125   SUBROUTINE ice_dyn_adv_init
126      !!-------------------------------------------------------------------
127      !!                  ***  ROUTINE ice_dyn_adv_init  ***
128      !!
129      !! ** Purpose :   Physical constants and parameters linked to the ice
130      !!                dynamics
131      !!
132      !! ** Method  :   Read the namdyn_adv namelist and check the ice-dynamic
133      !!                parameter values called at the first timestep (nit000)
134      !!
135      !! ** input   :   Namelist namdyn_adv
136      !!-------------------------------------------------------------------
137      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
138      !!
139      NAMELIST/namdyn_adv/ ln_adv_Pra, ln_adv_UMx, nn_UMx
140      !!-------------------------------------------------------------------
141      !
142      REWIND( numnam_ice_ref )         ! Namelist namdyn_adv in reference namelist : Ice dynamics
143      READ  ( numnam_ice_ref, namdyn_adv, IOSTAT = ios, ERR = 901)
144901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp )
145      !
146      REWIND( numnam_ice_cfg )         ! Namelist namdyn_adv in configuration namelist : Ice dynamics
147      READ  ( numnam_ice_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 )
148902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp )
149      IF(lwm) WRITE ( numoni, namdyn_adv )
150      !
151      IF(lwp) THEN                     ! control print
152         WRITE(numout,*)
153         WRITE(numout,*) 'ice_dyn_adv_init: ice parameters for ice dynamics '
154         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
155         WRITE(numout,*) '   Namelist namdyn_adv:'
156         WRITE(numout,*) '      type of advection scheme (Prather)             ln_adv_Pra = ', ln_adv_Pra 
157         WRITE(numout,*) '      type of advection scheme (Ulimate-Macho)       ln_adv_UMx = ', ln_adv_UMx 
158         WRITE(numout,*) '         order of the Ultimate-Macho scheme          nn_UMx     = ', nn_UMx
159      ENDIF
160      !
161      !                             !== set the choice of ice advection ==!
162      ioptio = 0 
163      IF( ln_adv_Pra ) THEN   ;   ioptio = ioptio + 1   ;   nice_adv = np_advPRA    ;   ENDIF
164      IF( ln_adv_UMx ) THEN   ;   ioptio = ioptio + 1   ;   nice_adv = np_advUMx    ;   ENDIF
165      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)' )
166      !
167      IF( ln_adv_Pra )   CALL adv_pra_rst( 'READ' )  !* read or initialize all required files
168      !
169   END SUBROUTINE ice_dyn_adv_init
170
171#else
172   !!----------------------------------------------------------------------
173   !!   Default option         Empty Module           NO ESIM sea-ice model
174   !!----------------------------------------------------------------------
175#endif
176
177   !!======================================================================
178END MODULE icedyn_adv
179
Note: See TracBrowser for help on using the repository browser.