MODULE icerhg !!====================================================================== !! *** MODULE icerhg *** !! Sea-Ice dynamics : !!====================================================================== !! history : 1.0 ! 2002-08 (C. Ethe, G. Madec) original VP code !! 3.0 ! 2007-03 (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle) LIM3: EVP-Cgrid !! 3.5 ! 2011-02 (G. Madec) dynamical allocation !!---------------------------------------------------------------------- #if defined key_lim3 !!---------------------------------------------------------------------- !! 'key_lim3' LIM3 sea-ice model !!---------------------------------------------------------------------- !! ice_rhg : computes ice velocities !! ice_rhg_init : initialization and namelist read !!---------------------------------------------------------------------- USE phycst ! physical constants USE dom_oce ! ocean space and time domain USE ice ! sea-ice: variables USE icerhg_evp ! sea-ice: EVP rheology USE icectl ! sea-ice: control prints USE icevar ! sea-ice: operations ! USE lbclnk ! lateral boundary conditions - MPP exchanges USE lib_mpp ! MPP library USE in_out_manager ! I/O manager USE lib_fortran ! glob_sum USE timing ! Timing IMPLICIT NONE PRIVATE PUBLIC ice_rhg ! routine called by icestp.F90 PUBLIC ice_rhg_init ! routine called by icestp.F90 !! * Substitutions # include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/ICE 4.0 , NEMO Consortium (2017) !! $Id: icerhg.F90 8378 2017-07-26 13:55:59Z clem $ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE ice_rhg( kt ) !!------------------------------------------------------------------- !! *** ROUTINE ice_rhg *** !! !! ** Purpose : compute ice velocity !! !! ** Action : comupte - ice velocity (u_ice, v_ice) !! - 3 components of the stress tensor (stress1_i, stress2_i, stress12_i) !! - shear, divergence and delta (shear_i, divu_i, delta_i) !!-------------------------------------------------------------------- INTEGER, INTENT(in) :: kt ! ice time step !! INTEGER :: jl ! dummy loop indices REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b !!-------------------------------------------------------------------- ! IF( nn_timing == 1 ) CALL timing_start('icerhg') ! IF( kt == nit000 .AND. lwp ) THEN WRITE(numout,*) WRITE(numout,*)'ice_rhg : sea-ice rheology' WRITE(numout,*)'~~~~~~~~' ENDIF CALL ice_var_agg(1) ! -- aggregate ice categories ! ! ! -- conservation test IF( ln_limdiachk ) CALL ice_cons_hsm(0, 'icerhg', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) ! IF( ln_landfast ) THEN ! -- Landfast ice parameterization: define max bottom friction DO jl = 1, jpl WHERE( ht_i(:,:,jl) > ht_n(:,:) * rn_gamma ) ; tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr ELSEWHERE ; tau_icebfr(:,:) = 0._wp END WHERE END DO ENDIF ! ----------------------- ! Rheology (ice dynamics) ! ----------------------- IF( nn_limdyn /= 0 ) THEN ! -- Ice dynamics ! CALL ice_rhg_evp( stress1_i, stress2_i, stress12_i, u_ice, v_ice, shear_i, divu_i, delta_i ) ! ELSE ! -- prescribed uniform velocity ! u_ice(:,:) = rn_uice * umask(:,:,1) v_ice(:,:) = rn_vice * vmask(:,:,1) !!CALL RANDOM_NUMBER(u_ice(:,:)) !!CALL RANDOM_NUMBER(v_ice(:,:)) ! ENDIF ! ! !- conservation test IF( ln_limdiachk ) CALL ice_cons_hsm(1, 'icerhg', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) IF( ln_ctl ) CALL ice_prt3D ('icerhg') !- Control prints IF( nn_timing == 1 ) CALL timing_stop('icerhg') !- timing ! END SUBROUTINE ice_rhg SUBROUTINE ice_rhg_init !!------------------------------------------------------------------- !! *** ROUTINE ice_rhg_init *** !! !! ** Purpose : Physical constants and parameters linked to the ice !! dynamics !! !! ** Method : Read the namicedyn namelist and check the ice-dynamic !! parameter values called at the first timestep (nit000) !! !! ** input : Namelist namicedyn !!------------------------------------------------------------------- INTEGER :: ios ! Local integer output status for namelist read !! NAMELIST/namicedyn/ nn_limadv , nn_limadv_ord, & & nn_icestr , rn_pe_rdg, rn_pstar , rn_crhg, ln_icestr_bvf , & & rn_ishlat , rn_cio , rn_creepl, rn_ecc , nn_nevp, rn_relast, & & ln_landfast, rn_gamma , rn_icebfr, rn_lfrelax !!------------------------------------------------------------------- ! REWIND( numnam_ice_ref ) ! Namelist namicedyn in reference namelist : Ice dynamics READ ( numnam_ice_ref, namicedyn, IOSTAT = ios, ERR = 901) 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedyn in reference namelist', lwp ) ! REWIND( numnam_ice_cfg ) ! Namelist namicedyn in configuration namelist : Ice dynamics READ ( numnam_ice_cfg, namicedyn, IOSTAT = ios, ERR = 902 ) 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicedyn in configuration namelist', lwp ) IF(lwm) WRITE ( numoni, namicedyn ) ! IF(lwp) THEN ! control print WRITE(numout,*) WRITE(numout,*) 'ice_rhg_init : ice parameters for ice dynamics ' WRITE(numout,*) '~~~~~~~~~~~~' WRITE(numout,*) ' Namelist namicedyn' WRITE(numout,*) ' advection scheme for ice transport (limtrp)' WRITE(numout,*) ' type of advection scheme (-1=Prather, 0=Ulimate-Macho) nn_limadv = ', nn_limadv WRITE(numout,*) ' order of the scheme for Ultimate-Macho case nn_limadv_ord = ', nn_limadv_ord WRITE(numout,*) ' ridging/rafting (icerdgrft)' WRITE(numout,*) ' ice strength parameterization (0=Hibler 1=Rothrock) nn_icestr = ', nn_icestr WRITE(numout,*) ' Ratio of ridging work to PotEner change in ridging rn_pe_rdg = ', rn_pe_rdg WRITE(numout,*) ' 1st bulk-rheology parameter rn_pstar = ', rn_pstar WRITE(numout,*) ' 2nd bulk-rhelogy parameter rn_crhg = ', rn_crhg WRITE(numout,*) ' brine volume included in ice strength computation ln_icestr_bvf = ', ln_icestr_bvf WRITE(numout,*) ' rheology EVP (icerhg_evp)' WRITE(numout,*) ' lateral boundary condition for sea ice dynamics rn_ishlat = ', rn_ishlat WRITE(numout,*) ' drag coefficient for oceanic stress rn_cio = ', rn_cio WRITE(numout,*) ' creep limit rn_creepl = ', rn_creepl WRITE(numout,*) ' eccentricity of the elliptical yield curve rn_ecc = ', rn_ecc WRITE(numout,*) ' number of iterations for subcycling nn_nevp = ', nn_nevp WRITE(numout,*) ' ratio of elastic timescale over ice time step rn_relast = ', rn_relast WRITE(numout,*) ' Landfast: param (T or F) ln_landfast = ', ln_landfast WRITE(numout,*) ' fraction of ocean depth that ice must reach rn_gamma = ', rn_gamma WRITE(numout,*) ' maximum bottom stress per unit area of contact rn_icebfr = ', rn_icebfr WRITE(numout,*) ' relax time scale (s-1) to reach static friction rn_lfrelax = ', rn_lfrelax ENDIF ! IF ( rn_ishlat == 0. ) THEN ; IF(lwp) WRITE(numout,*) ' ===>>> ice lateral free-slip' ELSEIF ( rn_ishlat == 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ===>>> ice lateral no-slip' ELSEIF ( 0. < rn_ishlat .AND. rn_ishlat < 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ===>>> ice lateral partial-slip' ELSEIF ( 2. < rn_ishlat ) THEN ; IF(lwp) WRITE(numout,*) ' ===>>> ice lateral strong-slip' ENDIF ! IF( .NOT. ln_landfast ) tau_icebfr(:,:) = 0._wp ! NO Landfast ice : set to zero one for all ! END SUBROUTINE ice_rhg_init #else !!---------------------------------------------------------------------- !! Default option Empty module NO LIM-3 sea-ice model !!---------------------------------------------------------------------- #endif !!====================================================================== END MODULE icerhg