MODULE iceini !!====================================================================== !! *** MODULE iceini *** !! Sea-ice model : LIM Sea ice model Initialization !!====================================================================== !! History : 3.0 ! 2008-03 (M. Vancoppenolle) LIM-3 original code !! 3.3 ! 2010-12 (G. Madec) add call to lim_thd_init and lim_thd_sal_init !! 4.0 ! 2011-02 (G. Madec) dynamical allocation !!---------------------------------------------------------------------- #if defined key_lim3 !!---------------------------------------------------------------------- !! 'key_lim3' LIM sea-ice model !!---------------------------------------------------------------------- !! ice_init : sea-ice model initialization !!---------------------------------------------------------------------- USE phycst ! physical constants USE dom_oce ! ocean domain USE sbc_oce ! Surface boundary condition: ocean fields USE sbc_ice ! Surface boundary condition: ice fields USE ice ! LIM variables USE par_ice ! LIM parameters USE dom_ice ! LIM domain USE thd_ice ! LIM thermodynamical variables USE limitd_me ! LIM ice thickness distribution USE limmsh ! LIM mesh USE limistate ! LIM initial state USE limrst ! LIM restart USE limthd ! LIM ice thermodynamics USE limthd_sal ! LIM ice thermodynamics: salinity USE limvar ! LIM variables USE limsbc ! LIM surface boundary condition USE in_out_manager ! I/O manager USE lib_mpp ! MPP library USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) IMPLICIT NONE PRIVATE PUBLIC ice_init ! called by sbcice_lim.F90 !!---------------------------------------------------------------------- !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) !! $Id$ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE ice_init !!---------------------------------------------------------------------- !! *** ROUTINE ice_init *** !! !! ** purpose : Allocate all the dynamic arrays of the LIM-3 modules !!---------------------------------------------------------------------- INTEGER :: ierr !!---------------------------------------------------------------------- ! ! Allocate the ice arrays ierr = ice_alloc () ! ice variables ierr = ierr + dom_ice_alloc () ! domain ierr = ierr + sbc_ice_alloc () ! surface forcing ierr = ierr + thd_ice_alloc () ! thermodynamics ierr = ierr + lim_itd_me_alloc () ! ice thickness distribution - mechanics ! IF( lk_mpp ) CALL mpp_sum( ierr ) IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays') ! ! ! adequation jpk versus ice/snow layers/categories IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk ) & & CALL ctl_stop( 'STOP', & & 'ice_init: the 3rd dimension of workspace arrays is too small.', & & 'use more ocean levels or less ice/snow layers/categories.' ) ! Open the reference and configuration namelist files and namelist output file CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) ! CALL ice_run ! set some ice run parameters ! CALL lim_thd_init ! set ice thermodynics parameters ! CALL lim_thd_sal_init ! set ice salinity parameters ! rdt_ice = nn_fsbc * rdttra(1) ! sea-ice timestep r1_rdtice = 1._wp / rdt_ice ! sea-ice timestep inverse ! CALL lim_msh ! ice mesh initialization ! CALL lim_itd_ini ! ice thickness distribution initialization ! CALL lim_itd_me_init ! ice thickness distribution initialization ! ! Initial sea-ice state IF( .NOT. ln_rstart ) THEN ! start from rest 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 ! start from a restart file CALL lim_rst_read ! read the restart file numit = nit000 - 1 CALL lim_var_agg(1) ! aggregate ice variables CALL lim_var_glo2eqv ! convert global var in equivalent variables ENDIF ! hi_max(jpl) = 99._wp ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl) ! CALL lim_sbc_init ! ice surface boundary condition ! fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction tn_ice(:,:,:) = t_su(:,:,:) ! initialisation of surface temp for coupled simu ! 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 !!------------------------------------------------------------------- NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, amax, ln_nicep, ln_limdiahsb, ln_limdiaout INTEGER :: ios ! Local integer output status for namelist read !!------------------------------------------------------------------- ! REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) REWIND( numnam_ice_cfg ) ! Namelist namicerun in configuration namelist : Parameters for ice READ ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 ) 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) IF(lwm) WRITE ( numoni, 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 ! control print 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,*) ' maximum ice concentration = ', amax WRITE(numout,*) ' Several ice points in the ice or not in ocean.output = ', ln_nicep WRITE(numout,*) ' Diagnose heat/salt budget or not ln_limdiahsb = ', ln_limdiahsb WRITE(numout,*) ' Output heat/salt budget or not ln_limdiaout = ', ln_limdiaout ENDIF ! END SUBROUTINE ice_run SUBROUTINE lim_itd_ini !!------------------------------------------------------------------ !! *** ROUTINE lim_itd_ini *** !! !! ** Purpose : Initializes the ice thickness distribution !! ** Method : ... !! Note : hi_max(jpl) is here set up to a value close to 7 m for !! limistate (only) and is changed to 99 m in ice_init !!------------------------------------------------------------------ INTEGER :: jl ! dummy loop index REAL(wp) :: zc1, zc2, zc3, zx1 ! local scalars !!------------------------------------------------------------------ IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution ' IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' !------------------------------------------------------------------------------! ! 1) Ice thickness distribution parameters initialization !------------------------------------------------------------------------------! IF(lwp) THEN WRITE(numout,*) ' Number of ice categories jpl = ', jpl ENDIF !- Thickness categories boundaries !---------------------------------- hi_max(:) = 0._wp zc1 = 3._wp / REAL( jpl, wp ) zc2 = 10._wp * zc1 zc3 = 3._wp DO jl = 1, jpl zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) END DO IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) ! DO jl = 1, jpl hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp END DO ! ! 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 #endif !!====================================================================== END MODULE iceini