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_rhg.F90 in NEMO/branches/UKMO/NEMO_4.0_add_pond_lids_prints/src/ICE – NEMO

source: NEMO/branches/UKMO/NEMO_4.0_add_pond_lids_prints/src/ICE/icedyn_rhg.F90 @ 12475

Last change on this file since 12475 was 12475, checked in by dancopsey, 4 years ago
  • Add more print statements.
  • Move away from using snow to ice diagnostics and use a new snow to pond one instead.
File size: 8.0 KB
RevLine 
[8586]1MODULE icedyn_rhg
2   !!======================================================================
3   !!                     ***  MODULE  icedyn_rhg  ***
4   !!   Sea-Ice dynamics : master routine for rheology
5   !!======================================================================
[9604]6   !! history :  4.0  !  2018     (C. Rousset)      Original code
[8586]7   !!----------------------------------------------------------------------
[9570]8#if defined key_si3
[8586]9   !!----------------------------------------------------------------------
[9570]10   !!   'key_si3'                                       SI3 sea-ice model
[8586]11   !!----------------------------------------------------------------------
12   !!    ice_dyn_rhg      : computes ice velocities
13   !!    ice_dyn_rhg_init : initialization and namelist read
14   !!----------------------------------------------------------------------
15   USE phycst         ! physical constants
16   USE dom_oce        ! ocean space and time domain
17   USE ice            ! sea-ice: variables
18   USE icedyn_rhg_evp ! sea-ice: EVP rheology
19   USE icectl         ! sea-ice: control prints
20   !
21   USE in_out_manager ! I/O manager
22   USE lib_mpp        ! MPP library
23   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
24   USE timing         ! Timing
25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC   ice_dyn_rhg        ! called by icestp.F90
30   PUBLIC   ice_dyn_rhg_init   ! called by icestp.F90
31
32   INTEGER ::              nice_rhg   ! choice of the type of rheology
33   !                                        ! associated indices:
34   INTEGER, PARAMETER ::   np_rhgEVP = 1   ! EVP rheology
35!! INTEGER, PARAMETER ::   np_rhgEAP = 2   ! EAP rheology
36
37   ! ** namelist (namrhg) **
38   LOGICAL ::   ln_rhg_EVP       ! EVP rheology
39   !
40   !! * Substitutions
41#  include "vectopt_loop_substitute.h90"
42   !!----------------------------------------------------------------------
[9598]43   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
[10069]44   !! $Id$
[10413]45   !! Software governed by the CeCILL licence     (./LICENSE)
[8586]46   !!----------------------------------------------------------------------
47CONTAINS
48
49   SUBROUTINE ice_dyn_rhg( kt )
50      !!-------------------------------------------------------------------
51      !!               ***  ROUTINE ice_dyn_rhg  ***
52      !!               
53      !! ** Purpose :   compute ice velocity
54      !!
55      !! ** Action  : comupte - ice velocity (u_ice, v_ice)
56      !!                      - 3 components of the stress tensor (stress1_i, stress2_i, stress12_i)
57      !!                      - shear, divergence and delta (shear_i, divu_i, delta_i)
58      !!--------------------------------------------------------------------
59      INTEGER, INTENT(in) ::   kt     ! ice time step
[11081]60      !
61      INTEGER  ::   jl   ! dummy loop indices
[8586]62      !!--------------------------------------------------------------------
63      ! controls
[9124]64      IF( ln_timing    )   CALL timing_start('icedyn_rhg')                                                             ! timing
[12475]65      write(numout,*)'ice_dyn_rhg 1: u_ice = ',u_ice(3,4)
[9124]66      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icedyn_rhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
[8586]67      !
68      IF( kt == nit000 .AND. lwp ) THEN
69         WRITE(numout,*)
70         WRITE(numout,*)'ice_dyn_rhg: sea-ice rheology'
71         WRITE(numout,*)'~~~~~~~~~~~'
72      ENDIF
[11081]73      !
74      IF( ln_landfast_home ) THEN      !-- Landfast ice parameterization
75         tau_icebfr(:,:) = 0._wp
76         DO jl = 1, jpl
77            WHERE( h_i(:,:,jl) > ht_n(:,:) * rn_depfra )   tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr
78         END DO
79      ENDIF
[12475]80      write(numout,*)'ice_dyn_rhg 2: u_ice = ',u_ice(3,4)
[11081]81      !
82      !--------------!
83      !== Rheology ==!
84      !--------------!   
[8586]85      SELECT CASE( nice_rhg )
86      !                                !------------------------!
87      CASE( np_rhgEVP )                ! Elasto-Viscous-Plastic !
88         !                             !------------------------!
[8813]89         CALL ice_dyn_rhg_evp( kt, stress1_i, stress2_i, stress12_i, shear_i, divu_i, delta_i )
[12475]90         write(numout,*)'ice_dyn_rhg 3: u_ice = ',u_ice(3,4)
[8586]91         !         
92      END SELECT
93      !
94      IF( lrst_ice ) THEN                       !* write EVP fields in the restart file
95         IF( ln_rhg_EVP )   CALL rhg_evp_rst( 'WRITE', kt )
[12475]96         write(numout,*)'ice_dyn_rhg 4: u_ice = ',u_ice(3,4)
[8586]97      ENDIF
98      !
99      ! controls
[9124]100      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icedyn_rhg', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
[12475]101      write(numout,*)'ice_dyn_rhg 5: u_ice = ',u_ice(3,4)
[9124]102      IF( ln_ctl       )   CALL ice_prt3D   ('icedyn_rhg')                                                             ! prints
[12475]103      write(numout,*)'ice_dyn_rhg 6: u_ice = ',u_ice(3,4)
104      IF( ln_timing    )   CALL timing_stop ('icedyn_rhg') 
105      write(numout,*)'ice_dyn_rhg 7: u_ice = ',u_ice(3,4)                                                           ! timing
[8586]106      !
107   END SUBROUTINE ice_dyn_rhg
108
[9124]109
[8586]110   SUBROUTINE ice_dyn_rhg_init
111      !!-------------------------------------------------------------------
112      !!                  ***  ROUTINE ice_dyn_rhg_init  ***
113      !!
114      !! ** Purpose : Physical constants and parameters linked to the ice
115      !!      dynamics
116      !!
117      !! ** Method  :  Read the namdyn_rhg namelist and check the ice-dynamic
118      !!       parameter values called at the first timestep (nit000)
119      !!
120      !! ** input   :   Namelist namdyn_rhg
121      !!-------------------------------------------------------------------
122      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read
123      !!
[8813]124      NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, rn_creepl, rn_ecc , nn_nevp, rn_relast
[8586]125      !!-------------------------------------------------------------------
126      !
127      REWIND( numnam_ice_ref )         ! Namelist namdyn_rhg in reference namelist : Ice dynamics
128      READ  ( numnam_ice_ref, namdyn_rhg, IOSTAT = ios, ERR = 901)
129901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_rhg in reference namelist', lwp )
130      REWIND( numnam_ice_cfg )         ! Namelist namdyn_rhg in configuration namelist : Ice dynamics
131      READ  ( numnam_ice_cfg, namdyn_rhg, IOSTAT = ios, ERR = 902 )
[9124]132902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namdyn_rhg in configuration namelist', lwp )
[8586]133      IF(lwm) WRITE ( numoni, namdyn_rhg )
134      !
135      IF(lwp) THEN                     ! control print
136         WRITE(numout,*)
137         WRITE(numout,*) 'ice_dyn_rhg_init: ice parameters for ice dynamics '
138         WRITE(numout,*) '~~~~~~~~~~~~~~~'
[9169]139         WRITE(numout,*) '   Namelist : namdyn_rhg:'
[8586]140         WRITE(numout,*) '      rheology EVP (icedyn_rhg_evp)                        ln_rhg_EVP = ', ln_rhg_EVP
[8813]141         WRITE(numout,*) '         use adaptive EVP (aEVP)                           ln_aEVP    = ', ln_aEVP
[8586]142         WRITE(numout,*) '         creep limit                                       rn_creepl  = ', rn_creepl
143         WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc     = ', rn_ecc
144         WRITE(numout,*) '         number of iterations for subcycling               nn_nevp    = ', nn_nevp
145         WRITE(numout,*) '         ratio of elastic timescale over ice time step     rn_relast  = ', rn_relast
146      ENDIF
147      !
148      !                             !== set the choice of ice advection ==!
149      ioptio = 0 
150      IF( ln_rhg_EVP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEVP    ;   ENDIF
151!!    IF( ln_rhg_EAP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEAP    ;   ENDIF
152      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_dyn_rhg_init: choose one and only one ice rheology' )
153      !
[8813]154      IF( ln_rhg_EVP  )   CALL rhg_evp_rst( 'READ' )  !* read or initialize all required files
[8586]155      !
156   END SUBROUTINE ice_dyn_rhg_init
157
158#else
159   !!----------------------------------------------------------------------
[9570]160   !!   Default option         Empty module           NO SI3 sea-ice model
[8586]161   !!----------------------------------------------------------------------
162#endif 
163
164   !!======================================================================
165END MODULE icedyn_rhg
Note: See TracBrowser for help on using the repository browser.