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

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icerhg.F90 @ 8486

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

changes in style - part1 - (now the code looks better txs to Gurvan's comments)

File size: 9.6 KB
RevLine 
[8407]1MODULE icerhg
2   !!======================================================================
3   !!                     ***  MODULE  icerhg  ***
4   !!   Sea-Ice dynamics : 
5   !!======================================================================
6   !! history :  1.0  ! 2002-08  (C. Ethe, G. Madec)  original VP code
7   !!            3.0  ! 2007-03  (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle)  LIM3: EVP-Cgrid
8   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation
9   !!----------------------------------------------------------------------
10#if defined key_lim3
11   !!----------------------------------------------------------------------
[8486]12   !!   'key_lim3'                                       LIM3 sea-ice model
[8407]13   !!----------------------------------------------------------------------
14   !!    ice_rhg      : computes ice velocities
15   !!    ice_rhg_init : initialization and namelist read
16   !!----------------------------------------------------------------------
[8486]17   USE phycst         ! physical constants
18   USE dom_oce        ! ocean space and time domain
19   USE ice            ! sea-ice: variables
20   USE icerhg_evp     ! sea-ice: EVP rheology
21   USE icectl         ! sea-ice: control prints
22   USE icevar         ! sea-ice: operations
[8407]23   !
[8486]24   USE lbclnk         ! lateral boundary conditions - MPP exchanges
25   USE lib_mpp        ! MPP library
26   USE in_out_manager ! I/O manager
27   USE lib_fortran    ! glob_sum
28   USE timing         ! Timing
[8407]29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   ice_rhg        ! routine called by icestp.F90
34   PUBLIC   ice_rhg_init   ! routine called by icestp.F90
35
36   !! * Substitutions
37#  include "vectopt_loop_substitute.h90"
38   !!----------------------------------------------------------------------
[8486]39   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
[8407]40   !! $Id: icerhg.F90 8378 2017-07-26 13:55:59Z clem $
41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
42   !!----------------------------------------------------------------------
43CONTAINS
44
45   SUBROUTINE ice_rhg( kt )
46      !!-------------------------------------------------------------------
47      !!               ***  ROUTINE ice_rhg  ***
48      !!               
49      !! ** Purpose :   compute ice velocity
50      !!
51      !! ** Action  : comupte - ice velocity (u_ice, v_ice)
52      !!                      - 3 components of the stress tensor (stress1_i, stress2_i, stress12_i)
53      !!                      - shear, divergence and delta (shear_i, divu_i, delta_i)
54      !!--------------------------------------------------------------------
[8486]55      INTEGER, INTENT(in) ::   kt     ! ice time step
[8407]56      !!
[8486]57      INTEGER  ::   jl   ! dummy loop indices
[8407]58      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
59      !!--------------------------------------------------------------------
[8486]60      !
[8407]61      IF( nn_timing == 1 )  CALL timing_start('icerhg')
[8486]62      !
[8426]63      IF( kt == nit000 .AND. lwp ) THEN
64         WRITE(numout,*)
[8486]65         WRITE(numout,*)'ice_rhg : sea-ice rheology'
66         WRITE(numout,*)'~~~~~~~~'
[8426]67      ENDIF
68
[8486]69      CALL ice_var_agg(1)           ! -- aggregate ice categories
[8407]70      !
[8486]71      !                             ! -- conservation test
72      IF( ln_limdiachk )   CALL ice_cons_hsm(0, 'icerhg', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
73      !                     
74      IF( ln_landfast ) THEN        ! -- Landfast ice parameterization: define max bottom friction
[8407]75         DO jl = 1, jpl
[8486]76            WHERE( ht_i(:,:,jl) > ht_n(:,:) * rn_gamma )   ;   tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr
77            ELSEWHERE                                      ;   tau_icebfr(:,:) = 0._wp
78            END WHERE
[8407]79         END DO
80      ENDIF
81     
82      ! -----------------------
83      ! Rheology (ice dynamics)
84      ! -----------------------   
[8486]85      IF( nn_limdyn /= 0 ) THEN     ! -- Ice dynamics
86         !
[8407]87         CALL ice_rhg_evp( stress1_i, stress2_i, stress12_i, u_ice, v_ice, shear_i, divu_i, delta_i )
[8486]88         !
89      ELSE                          ! -- prescribed uniform velocity
90         !
91         u_ice(:,:) = rn_uice * umask(:,:,1)
[8407]92         v_ice(:,:) = rn_vice * vmask(:,:,1)
93         !!CALL RANDOM_NUMBER(u_ice(:,:))
94         !!CALL RANDOM_NUMBER(v_ice(:,:))
[8486]95         !
[8407]96      ENDIF
97      !
[8486]98      !                                                   !- conservation test
99      IF( ln_limdiachk   )   CALL ice_cons_hsm(1, 'icerhg', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
100      IF( ln_ctl         )   CALL ice_prt3D  ('icerhg')   !- Control prints
101      IF( nn_timing == 1 )   CALL timing_stop('icerhg')   !- timing
[8407]102      !
103   END SUBROUTINE ice_rhg
104
105
106   SUBROUTINE ice_rhg_init
107      !!-------------------------------------------------------------------
108      !!                  ***  ROUTINE ice_rhg_init  ***
109      !!
110      !! ** Purpose : Physical constants and parameters linked to the ice
111      !!      dynamics
112      !!
113      !! ** Method  :  Read the namicedyn namelist and check the ice-dynamic
114      !!       parameter values called at the first timestep (nit000)
115      !!
116      !! ** input   :   Namelist namicedyn
117      !!-------------------------------------------------------------------
[8486]118      INTEGER ::   ios   ! Local integer output status for namelist read
119      !!
120      NAMELIST/namicedyn/ nn_limadv  , nn_limadv_ord,                                       &
121         &                nn_icestr  , rn_pe_rdg, rn_pstar , rn_crhg, ln_icestr_bvf     ,   &
122         &                rn_ishlat  , rn_cio   , rn_creepl, rn_ecc , nn_nevp, rn_relast,   &
123         &                ln_landfast, rn_gamma , rn_icebfr, rn_lfrelax
[8407]124      !!-------------------------------------------------------------------
[8486]125      !
126      REWIND( numnam_ice_ref )         ! Namelist namicedyn in reference namelist : Ice dynamics
[8407]127      READ  ( numnam_ice_ref, namicedyn, IOSTAT = ios, ERR = 901)
128901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedyn in reference namelist', lwp )
[8486]129      !
130      REWIND( numnam_ice_cfg )         ! Namelist namicedyn in configuration namelist : Ice dynamics
[8407]131      READ  ( numnam_ice_cfg, namicedyn, IOSTAT = ios, ERR = 902 )
132902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedyn in configuration namelist', lwp )
133      IF(lwm) WRITE ( numoni, namicedyn )
[8486]134      !
135      IF(lwp) THEN                     ! control print
[8407]136         WRITE(numout,*)
137         WRITE(numout,*) 'ice_rhg_init : ice parameters for ice dynamics '
138         WRITE(numout,*) '~~~~~~~~~~~~'
[8486]139         WRITE(numout,*) '   Namelist namicedyn'
140         WRITE(numout,*) '      advection scheme for ice transport (limtrp)'
141         WRITE(numout,*) '         type of advection scheme (-1=Prather, 0=Ulimate-Macho)   nn_limadv     = ', nn_limadv 
142         WRITE(numout,*) '         order of the scheme for Ultimate-Macho case              nn_limadv_ord = ', nn_limadv_ord
143         WRITE(numout,*) '      ridging/rafting (icerdgrft)'
144         WRITE(numout,*) '         ice strength parameterization (0=Hibler 1=Rothrock)      nn_icestr     = ', nn_icestr 
145         WRITE(numout,*) '         Ratio of ridging work to PotEner change in ridging       rn_pe_rdg     = ', rn_pe_rdg 
146         WRITE(numout,*) '         1st bulk-rheology parameter                              rn_pstar      = ', rn_pstar
147         WRITE(numout,*) '         2nd bulk-rhelogy parameter                               rn_crhg       = ', rn_crhg
148         WRITE(numout,*) '         brine volume included in ice strength computation        ln_icestr_bvf = ', ln_icestr_bvf
149         WRITE(numout,*) '      rheology EVP (icerhg_evp)'
150         WRITE(numout,*) '         lateral boundary condition for sea ice dynamics          rn_ishlat     = ', rn_ishlat
151         WRITE(numout,*) '         drag coefficient for oceanic stress                      rn_cio        = ', rn_cio
152         WRITE(numout,*) '         creep limit                                              rn_creepl     = ', rn_creepl
153         WRITE(numout,*) '         eccentricity of the elliptical yield curve               rn_ecc        = ', rn_ecc
154         WRITE(numout,*) '         number of iterations for subcycling                      nn_nevp       = ', nn_nevp
155         WRITE(numout,*) '         ratio of elastic timescale over ice time step            rn_relast     = ', rn_relast
156         WRITE(numout,*) '      Landfast: param (T or F)                                    ln_landfast   = ', ln_landfast
157         WRITE(numout,*) '         fraction of ocean depth that ice must reach              rn_gamma      = ', rn_gamma
158         WRITE(numout,*) '         maximum bottom stress per unit area of contact           rn_icebfr     = ', rn_icebfr
159         WRITE(numout,*) '         relax time scale (s-1) to reach static friction          rn_lfrelax    = ', rn_lfrelax
[8407]160      ENDIF
161      !
[8486]162      IF     (      rn_ishlat == 0.                ) THEN   ;   IF(lwp) WRITE(numout,*) '   ===>>>   ice lateral  free-slip'
163      ELSEIF (      rn_ishlat == 2.                ) THEN   ;   IF(lwp) WRITE(numout,*) '   ===>>>   ice lateral  no-slip'
164      ELSEIF ( 0. < rn_ishlat .AND. rn_ishlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ===>>>   ice lateral  partial-slip'
165      ELSEIF ( 2. < rn_ishlat                      ) THEN   ;   IF(lwp) WRITE(numout,*) '   ===>>>   ice lateral  strong-slip'
[8407]166      ENDIF
167      !
[8486]168      IF( .NOT. ln_landfast )   tau_icebfr(:,:) = 0._wp     ! NO Landfast ice : set to zero one for all
169      !
[8407]170   END SUBROUTINE ice_rhg_init
171
[8486]172#else
173   !!----------------------------------------------------------------------
174   !!   Default option         Empty module          NO LIM-3 sea-ice model
175   !!----------------------------------------------------------------------
[8407]176#endif 
177
178   !!======================================================================
179END MODULE icerhg
Note: See TracBrowser for help on using the repository browser.