MODULE iceini !!====================================================================== !! *** MODULE iceini *** !! Sea-ice model : LIM Sea ice model Initialization !!====================================================================== #if defined key_lim3 !!---------------------------------------------------------------------- !! 'key_lim3' : LIM sea-ice model !!---------------------------------------------------------------------- !! ice_init : sea-ice model initialization !!---------------------------------------------------------------------- USE dom_oce USE in_out_manager USE sbc_oce ! Surface boundary condition: ocean fields USE sbc_ice ! Surface boundary condition: ice fields USE phycst ! Define parameters for the routines USE ice USE limmsh USE limistate USE limrst USE par_ice USE limvar USE lib_mpp IMPLICIT NONE PRIVATE !! * Routine accessibility PUBLIC ice_init ! called by opa.F90 PUBLIC lim_itd_ini !! * Share Module variables INTEGER , PUBLIC :: & !: nstart , & !: iteration number of the begining of the run nlast , & !: iteration number of the end of the run nitrun , & !: number of iteration numit !: iteration number REAL(wp), PUBLIC :: & !: tpstot !: time of the run in seconds !!---------------------------------------------------------------------- !! LIM 3.0, UCL-ASTR-LOCEAN-IPSL (2008) !! $Id$ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- CONTAINS SUBROUTINE ice_init !!---------------------------------------------------------------------- !! *** ROUTINE ice_init *** !! !! ** purpose : !! !! History : !! 2.0 ! 02-08 (G. Madec) F90: Free form and modules !! 3.0 ! 08-03 (M. Vancop) ITD, salinity, EVP-C !!---------------------------------------------------------------------- ! Open the namelist file CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) CALL ice_run ! read in namelist some run parameters ! Louvain la Neuve Ice model IF( nacc == 1 ) THEN rdt_ice = nn_fsbc * rdtmin ELSE rdt_ice = nn_fsbc * rdt ENDIF CALL lim_msh ! ice mesh initialization CALL lim_itd_ini ! initialize the ice thickness ! distribution ! Initial sea-ice state IF( .NOT.ln_rstart ) THEN numit = 0 numit = nit000 - 1 CALL lim_istate ! start from rest: sea-ice deduced from sst CALL lim_var_agg(1) ! aggregate category variables in ! bulk variables CALL lim_var_glo2eqv ! convert global variables in equivalent ! variables ELSE CALL lim_rst_read ! start from a restart file numit = nit000 - 1 CALL lim_var_agg(1) ! aggregate ice variables CALL lim_var_glo2eqv ! convert global var in equivalent variables ENDIF fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction nstart = numit + nn_fsbc nitrun = nitend - nit000 + 1 nlast = numit + nitrun IF( nstock == 0 ) nstock = nlast + 1 END SUBROUTINE ice_init SUBROUTINE ice_run !!------------------------------------------------------------------- !! *** ROUTINE ice_run *** !! !! ** Purpose : Definition some run parameter for ice model !! !! ** Method : Read the namicerun namelist and check the parameter !! values called at the first timestep (nit000) !! !! ** input : Namelist namicerun !! !! history : !! 2.0 ! 03-08 (C. Ethe) Original code !! 3.0 ! 08-03 (M. Vancop) LIM3 !!------------------------------------------------------------------- NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, acrit, hsndif, hicdif, cai, cao, ln_nicep !!------------------------------------------------------------------- ! ! Read Namelist namicerun REWIND ( numnam_ice ) READ ( numnam_ice , namicerun ) IF( lk_mpp .AND. ln_nicep ) THEN ln_nicep = .FALSE. CALL ctl_warn( 'ice_run : specific control print for LIM3 desactivated with MPI' ) ENDIF IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice' WRITE(numout,*) ' ~~~~~~' WRITE(numout,*) ' switch for ice dynamics (1) or not (0) ln_limdyn = ', ln_limdyn WRITE(numout,*) ' minimum fraction for leads in the NH (SH) acrit(1/2) = ', acrit(:) WRITE(numout,*) ' computation of temp. in snow (=0) or not (=9999) hsndif = ', hsndif WRITE(numout,*) ' computation of temp. in ice (=0) or not (=9999) hicdif = ', hicdif WRITE(numout,*) ' atmospheric drag over sea ice = ', cai WRITE(numout,*) ' atmospheric drag over ocean = ', cao WRITE(numout,*) ' Several ice points in the ice or not in ocean.output = ', ln_nicep ENDIF END SUBROUTINE ice_run SUBROUTINE lim_itd_ini !!------------------------------------------------------------------ !! *** ROUTINE lim_itd_ini *** !! ** Purpose : !! Initializes the ice thickness distribution !! ** Method : !! Very simple. Currently there are no ice types in the !! model... !! !! ** Arguments : !! kideb , kiut : Starting and ending points on which the !! the computation is applied !! !! ** Inputs / Ouputs : (global commons) !! !! ** External : !! !! ** References : !! !! ** History : !! (12-2005) Martin Vancoppenolle !! !!------------------------------------------------------------------ !! * Arguments !! * Local variables INTEGER :: jl, & ! ice category dummy loop index jm ! ice types dummy loop index REAL(wp) :: & ! constant values zeps = 1.0e-10, & ! zc1 , & ! zc2 , & ! zc3 , & ! zx1 IF(lwp) WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution ' IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' !!-- End of declarations !!------------------------------------------------------------------------------ !------------------------------------------------------------------------------! ! 1) Ice thickness distribution parameters initialization !------------------------------------------------------------------------------! !- Types boundaries (integer) !---------------------------- ice_cat_bounds(1,1) = 1 ice_cat_bounds(1,2) = jpl !- Number of ice thickness categories in each ice type DO jm = 1, jpm ice_ncat_types(jm) = ice_cat_bounds(jm,2) - ice_cat_bounds(jm,1) + 1 END DO !- Make the correspondence between thickness categories and ice types !--------------------------------------------------------------------- DO jm = 1, jpm !over types DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) !over thickness categories ice_types(jl) = jm END DO END DO IF(lwp) THEN WRITE(numout,*) ' Number of ice types jpm = ', jpm WRITE(numout,*) ' Number of ice categories jpl = ', jpl DO jm = 1, jpm WRITE(numout,*) ' Ice type ', jm WRITE(numout,*) ' Number of thickness categories ', ice_ncat_types(jm) WRITE(numout,*) ' Thickness category boundaries ', ice_cat_bounds(jm,1:2) END DO WRITE(numout,*) 'Ice type vector', ice_types(1:jpl) WRITE(numout,*) ENDIF !- Thickness categories boundaries !---------------------------------- hi_max(:) = 0.0 hi_max_typ(:,:) = 0.0 !- Type 1 - undeformed ice zc1 = 3./REAL(ice_cat_bounds(1,2)-ice_cat_bounds(1,1)+1) zc2 = 10.0*zc1 zc3 = 3.0 DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) zx1 = REAL(jl-1) / REAL(ice_cat_bounds(1,2)-ice_cat_bounds(1,1)+1) hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1.0 + TANH ( zc3 * (zx1 - 1.0 ) ) ) END DO !- Fill in the hi_max_typ vector, useful in other circumstances ! Tricky trick ! hi_max_typ is actually not used in the code and will be removed in a ! next flyspray at this time, the tricky trick will also be removed ! Martin, march 08 DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) hi_max_typ(jl,1) = hi_max(jl) END DO IF(lwp) WRITE(numout,*) ' Thickness category boundaries independently of ice type ' IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) IF(lwp) WRITE(numout,*) ' Thickness category boundaries inside ice types ' IF(lwp) THEN DO jm = 1, jpm WRITE(numout,*) ' Type number ', jm WRITE(numout,*) ' hi_max_typ : ', hi_max_typ(0:ice_ncat_types(jm),jm) END DO ENDIF DO jl = 1, jpl hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) / 2.0 END DO tn_ice(:,:,:) = t_su(:,:,:) END SUBROUTINE lim_itd_ini #else !!---------------------------------------------------------------------- !! Default option : Empty module NO LIM sea-ice model !!---------------------------------------------------------------------- CONTAINS SUBROUTINE ice_init ! Empty routine END SUBROUTINE ice_init SUBROUTINE lim_itd_ini END SUBROUTINE lim_itd_ini #endif !!====================================================================== END MODULE iceini