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.
iceini.F90 in trunk/NEMO/LIM_SRC – NEMO

source: trunk/NEMO/LIM_SRC/iceini.F90 @ 391

Last change on this file since 391 was 391, checked in by opalod, 18 years ago

RB:nemo_v1_update_038: first integration of AGRIF :

add agrif to ice files

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.8 KB
Line 
1MODULE iceini
2   !!======================================================================
3   !!                       ***  MODULE iceini   ***
4   !!   Sea-ice model : LIM Sea ice model Initialization
5   !!======================================================================
6#if defined key_ice_lim
7   !!----------------------------------------------------------------------
8   !!   'key_ice_lim' :                                   LIM sea-ice model
9   !!----------------------------------------------------------------------
10   !!   ice_init       : sea-ice model initialization
11   !!----------------------------------------------------------------------
12   USE dom_oce
13   USE in_out_manager
14   USE ice_oce         ! ice variables
15   USE flx_oce
16   USE phycst          ! Define parameters for the routines
17   USE ocfzpt
18   USE ice
19   USE limmsh
20   USE limistate
21   USE limrst
22   USE ini1d           ! initialization of the 1D configuration
23
24   IMPLICIT NONE
25   PRIVATE
26
27   !! * Routine accessibility
28   PUBLIC ice_init                 ! called by opa.F90
29
30   !! * Share Module variables
31   LOGICAL , PUBLIC  ::   & !!! ** init namelist (namicerun) **
32      ln_limdyn   = .TRUE.   !: flag for ice dynamics (T) or not (F)
33   INTEGER , PUBLIC  ::   &  !:
34      nstart ,            &  !: iteration number of the begining of the run
35      nlast  ,            &  !: iteration number of the end of the run
36      nitrun ,            &  !: number of iteration
37      numit                  !: iteration number
38   REAL(wp), PUBLIC  ::   &  !:
39      hsndif = 0.e0 ,     &  !: computation of temp. in snow (0) or not (9999)
40      hicdif = 0.e0 ,     &  !: computation of temp. in ice (0) or not (9999)
41      tpstot                 !: time of the run in seconds
42   REAL(wp), PUBLIC, DIMENSION(2)  ::  &  !:
43      acrit  = (/ 1.e-06 , 1.e-06 /)    !: minimum fraction for leads in
44      !                                   !  north and south hemisphere
45   !!----------------------------------------------------------------------
46   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)
47   !! $Header$
48   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
49   !!----------------------------------------------------------------------
50
51CONTAINS
52
53   SUBROUTINE ice_init
54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE ice_init  ***
56      !!
57      !! ** purpose :   
58      !!
59      !! History :
60      !!   8.5  !  02-08  (G. Madec)  F90: Free form and modules
61      !!----------------------------------------------------------------------
62       CHARACTER(len=80) :: namelist_icename
63       
64      ! Open the namelist file
65      namelist_icename = 'namelist_ice'
66           
67      CALL ctlopn(numnam_ice,namelist_icename,'OLD', 'FORMATTED', 'SEQUENTIAL',   &
68                     1,numout,.FALSE.,1)     
69
70      CALL ice_run                    !  read in namelist some run parameters
71                 
72      ! Louvain la Neuve Ice model
73      IF( nacc == 1 ) THEN
74          dtsd2   = nfice * rdtmin * 0.5
75          rdt_ice = nfice * rdtmin
76      ELSE
77          dtsd2   = nfice * rdt * 0.5
78          rdt_ice = nfice * rdt
79      ENDIF
80
81      CALL lim_msh                    ! ice mesh initialization
82     
83      ! Initial sea-ice state
84      IF( .NOT.ln_rstart ) THEN
85         numit = 0
86         CALL lim_istate              ! start from rest: sea-ice deduced from sst
87      ELSE
88         CALL lim_rst_read( numit )   ! start from a restart file
89      ENDIF
90     
91      tn_ice(:,:) = sist(:,:)         ! initialisation of ice temperature   
92      freeze(:,:) = 1.0 - frld(:,:)   ! initialisation of sea/ice cover   
93# if defined key_coupled
94      alb_ice(:,:) = albege(:,:)      ! sea-ice albedo
95# endif
96     
97      nstart = numit  + nfice     
98      nitrun = nitend - nit000 + 1 
99      nlast  = numit  + nitrun 
100
101      IF( nstock == 0  )  nstock = nlast + 1
102
103   END SUBROUTINE ice_init
104
105
106   SUBROUTINE ice_run
107      !!-------------------------------------------------------------------
108      !!                  ***  ROUTINE ice_run ***
109      !!                 
110      !! ** Purpose :   Definition some run parameter for ice model
111      !!
112      !! ** Method  :   Read the namicerun namelist and check the parameter
113      !!       values called at the first timestep (nit000)
114      !!
115      !! ** input   :   Namelist namicerun
116      !!
117      !! history :
118      !!   2.0  !  03-08 (C. Ethe)  Original code
119      !!-------------------------------------------------------------------
120
121      NAMELIST/namicerun/ ln_limdyn, acrit, hsndif, hicdif
122      !!-------------------------------------------------------------------
123
124      !                                           ! Read Namelist namicerun
125      REWIND ( numnam_ice )
126      READ   ( numnam_ice , namicerun )
127
128      IF( lk_cfg_1d  )  ln_limdyn = .FALSE.       ! No ice transport in 1D configuration
129
130      IF(lwp) THEN
131         WRITE(numout,*)
132         WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
133         WRITE(numout,*) ' ~~~~~~'
134         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn
135         WRITE(numout,*) '   minimum fraction for leads in the NH (SH)  acrit(1/2)   = ', acrit(:)
136         WRITE(numout,*) '   computation of temp. in snow (=0) or not (=9999) hsndif = ', hsndif
137         WRITE(numout,*) '   computation of temp. in ice  (=0) or not (=9999) hicdif = ', hicdif
138      ENDIF
139   END SUBROUTINE ice_run
140
141#else
142   !!----------------------------------------------------------------------
143   !!   Default option :        Empty module           NO LIM sea-ice model
144   !!----------------------------------------------------------------------
145CONTAINS
146   SUBROUTINE ice_init        ! Empty routine
147   END SUBROUTINE ice_init
148#endif
149
150   !!======================================================================
151END MODULE iceini
Note: See TracBrowser for help on using the repository browser.