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_3 – NEMO

source: trunk/NEMO/LIM_SRC_3/iceini.F90 @ 833

Last change on this file since 833 was 830, checked in by ctlod, 16 years ago

dev_002_LIM : add declaration of Atmospheric drag coefficients over sea-ice & ocean cai/cao

File size: 12.2 KB
Line 
1MODULE iceini
2   !!======================================================================
3   !!                       ***  MODULE iceini   ***
4   !!   Sea-ice model : LIM Sea ice model Initialization
5   !!======================================================================
6#if defined key_lim3
7   !!----------------------------------------------------------------------
8   !!   'key_lim3' :                                   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 par_ice
23   USE limvar
24   USE limicepoints
25
26   IMPLICIT NONE
27   PRIVATE
28
29   !! * Routine accessibility
30   PUBLIC ice_init                 ! called by opa.F90
31   PUBLIC lim_itd_ini
32
33   !! * Share Module variables
34   LOGICAL , PUBLIC  ::     & !!! ** init namelist (namicerun) **
35      ln_limdyn   = .TRUE., & !: flag for ice dynamics (T) or not (F)
36      ln_nicep    = .TRUE.    !: flag for sea-ice points output (T) or not (F)
37   INTEGER , PUBLIC  ::   &  !:
38      nstart ,            &  !: iteration number of the begining of the run
39      nlast  ,            &  !: iteration number of the end of the run
40      nitrun ,            &  !: number of iteration
41      numit                  !: iteration number
42   REAL(wp), PUBLIC  ::   &  !:
43      hsndif = 0.e0    ,  &  !: computation of temp. in snow (0) or not (9999)
44      hicdif = 0.e0    ,  &  !: computation of temp. in ice (0) or not (9999)
45      tpstot           ,  &  !: time of the run in seconds
46      cai    = 1.40e-3 ,  &  !: atmospheric drag over sea ice
47      cao    = 1.00e-3       !: atmospheric drag over ocean
48   REAL(wp), PUBLIC, DIMENSION(2)  ::  &  !:
49      acrit  = (/ 1.e-06 , 1.e-06 /)    !: minimum fraction for leads in
50      !                                   !  north and south hemisphere
51   !!----------------------------------------------------------------------
52   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)
53   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/iceini.F90,v 1.4 2005/03/27 18:34:41 opalod Exp $
54   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
55   !!----------------------------------------------------------------------
56
57CONTAINS
58
59   SUBROUTINE ice_init
60      !!----------------------------------------------------------------------
61      !!                  ***  ROUTINE ice_init  ***
62      !!
63      !! ** purpose :   
64      !!
65      !! History :
66      !!   8.5  !  02-08  (G. Madec)  F90: Free form and modules
67      !!----------------------------------------------------------------------
68
69      INTEGER :: ji,jj,jk,jl, index
70
71      ! Open the namelist file
72      OPEN( numnam_ice, FILE= 'namelist_ice', FORM='formatted', STATUS = 'old') 
73
74      CALL ice_run                    !  read in namelist some run parameters
75
76      CALL lim_icepoints              !  define specific checking ice points
77                 
78      ! Louvain la Neuve Ice model
79      IF( nacc == 1 ) THEN
80          dtsd2   = nfice * rdtmin * 0.5
81          rdt_ice = nfice * rdtmin
82      ELSE
83          dtsd2   = nfice * rdt * 0.5
84          rdt_ice = nfice * rdt
85      ENDIF
86
87      CALL lim_msh                    ! ice mesh initialization
88     
89      CALL lim_itd_ini
90      ! Initial sea-ice state
91      IF( .NOT.ln_rstart ) THEN
92         numit = 0
93         ! martin ajoute
94         numit = nit000 - 1
95         CALL lim_istate              ! start from rest: sea-ice deduced from sst
96         CALL lim_var_agg(1)
97         CALL lim_var_glo2eqv
98      ELSE
99         CALL lim_rst_read( numit )   ! start from a restart file
100         ! martin ajoute
101         numit = nit000 - 1
102         CALL lim_var_agg(1)
103         CALL lim_var_glo2eqv
104      ENDIF
105
106      freeze(:,:) = at_i(:,:)   ! initialisation of sea/ice cover   
107# if defined key_coupled
108      alb_ice(:,:) = albege(:,:)      ! sea-ice albedo
109# endif
110     
111      nstart = numit  + nfice     
112      nitrun = nitend - nit000 + 1 
113      nlast  = numit  + nitrun 
114
115      IF( nstock == 0  )  nstock = nlast + 1
116
117   END SUBROUTINE ice_init
118
119   SUBROUTINE ice_run
120      !!-------------------------------------------------------------------
121      !!                  ***  ROUTINE ice_run ***
122      !!                 
123      !! ** Purpose :   Definition some run parameter for ice model
124      !!
125      !! ** Method  :   Read the namicerun namelist and check the parameter
126      !!       values called at the first timestep (nit000)
127      !!
128      !! ** input   :   Namelist namicerun
129      !!
130      !! history :
131      !!   2.0  !  03-08 (C. Ethe)  Original code
132      !!-------------------------------------------------------------------
133      NAMELIST/namicerun/ ln_limdyn, acrit, hsndif, hicdif, cai, cao, ln_nicep
134      !!-------------------------------------------------------------------
135
136      !                                           ! Read Namelist namicerun
137      REWIND ( numnam_ice )
138      READ   ( numnam_ice , namicerun )
139      IF(lwp) THEN
140         WRITE(numout,*)
141         WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
142         WRITE(numout,*) ' ~~~~~~'
143         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn
144         WRITE(numout,*) '   minimum fraction for leads in the NH (SH)  acrit(1/2)   = ', acrit(:)
145         WRITE(numout,*) '   computation of temp. in snow (=0) or not (=9999) hsndif = ', hsndif
146         WRITE(numout,*) '   computation of temp. in ice  (=0) or not (=9999) hicdif = ', hicdif
147         WRITE(numout,*) '   atmospheric drag over sea ice                           = ', cai
148         WRITE(numout,*) '   atmospheric drag over ocean                             = ', cao
149         WRITE(numout,*) '   Several ice points in the ice or not in ocean.output = ', ln_nicep
150      ENDIF
151     
152   END SUBROUTINE ice_run
153
154   SUBROUTINE lim_itd_ini
155        !!------------------------------------------------------------------
156        !!                ***  ROUTINE lim_itd_ini ***
157        !! ** Purpose :
158        !!            Initializes the ice thickness distribution
159        !! ** Method  :
160        !!            Very simple
161        !!
162        !! ** Arguments :
163        !!           kideb , kiut : Starting and ending points on which the
164        !!                         the computation is applied
165        !!
166        !! ** Inputs / Ouputs : (global commons)
167        !!
168        !! ** External :
169        !!
170        !! ** References :
171        !!
172        !! ** History :
173        !!           (12-2005) Martin Vancoppenolle
174        !!           Rien n'est jamais acquis
175        !!           A l'homme ni sa force
176        !!           Ni sa faiblesse ni son coeur
177        !!           Et quand il croit
178        !!           Ouvrir ses bras son ombre
179        !!           Est celle d'une croix
180        !!
181        !!------------------------------------------------------------------
182        !! * Arguments
183
184       !! * Local variables
185       INTEGER ::   ji,       &   ! spatial dummy loop index
186                    jl,       &   ! ice category dummy loop index
187                    jm            ! ice types    dummy loop index
188
189       REAL(wp)  ::           &  ! constant values
190          zeps      =  1.0e-10,   & !
191          zc1                 ,   & !
192          zc2                 ,   & !
193          zc3                 ,   & !
194          zx1
195
196       WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution '
197       WRITE(numout,*) '~~~~~~~~~~~~~~~'
198
199!!-- End of declarations
200!!----------------------------------------------------------------------------------------------
201
202!--------------------------------------------------------------------------------------------------!
203! 1) Ice thickness distribution parameters initialization                                          !
204!--------------------------------------------------------------------------------------------------!
205
206      !- Types boundaries in integer thickness space
207      !----------------------------------------------
208      !- Type 1 (undeformed ice) Boundaries
209      ice_cat_bounds(1,1) = 1
210      ice_cat_bounds(1,2) = jpl
211!     !- Type 2 (ridged ice  ) Boundaries
212!     ice_cat_bounds(2,1) = 4
213!     ice_cat_bounds(2,2) = 5
214!     !- Type 3 (rafted ice  ) Boundaries
215!     ice_cat_bounds(3,1) = 6
216!     ice_cat_bounds(3,2) = 6
217
218      !- Number of ice thickness categories in each ice type
219      DO jm = 1, jpm
220         ice_ncat_types(jm) = ice_cat_bounds(jm,2) - ice_cat_bounds(jm,1) + 1 
221      END DO
222
223      !- Make the correspondence between thickness categories and ice types
224      !---------------------------------------------------------------------
225      !- ice_types = 1 -> undeformed ice
226      !- ice_types = 2 -> ridged   ice
227      !- ice_types = 3 -> rafted   ice
228      DO jm = 1, jpm       !over types
229         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) !over thickness categories
230            ice_types(jl) = jm
231         END DO
232      END DO
233
234      WRITE(numout,*) ' Number of ice types jpm =      ', jpm
235      WRITE(numout,*) ' Number of ice categories jpl = ', jpl
236      DO jm = 1, jpm
237         WRITE(numout,*) ' Ice type ', jm
238         WRITE(numout,*) ' Number of thickness categories ', ice_ncat_types(jm)
239         WRITE(numout,*) ' Thickness category boundaries  ', ice_cat_bounds(jm,1:2)
240      END DO
241      WRITE(numout,*) 'Ice type vector', ice_types(1:jpl)
242      WRITE(numout,*)
243
244      !- Thickness categories boundaries in thickness space
245      !---------------------------------------------------------------------
246
247      ! NEW DEFINITION
248
249         hi_max(:) = 0.0
250         hi_max_typ(:,:) = 0.0
251
252! new categories
253!     !- Type 3 - rafted ice
254!        hi_max(ice_cat_bounds(3,2)) = 5.0
255
256!     !- Type 2 - ridged ice
257!        zc1 = 3./REAL(ice_cat_bounds(2,2)-ice_cat_bounds(2,1)+1)
258!        zc2 = 10.0*zc1
259!        zc3 = 3.0
260
261!        DO jl = ice_cat_bounds(2,1),ice_cat_bounds(2,2)
262!           zx1 = REAL(jl-ice_cat_bounds(2,1)+1) / REAL(ice_cat_bounds(2,2)-ice_cat_bounds(2,1)+1)
263!           hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1.0 + TANH ( zc3 * (zx1 - 1.0 ) ) )
264!        END DO
265
266!        ! force the thickness into the ice categories
267!        hi_max(ice_cat_bounds(2,1)) = 15.0
268!        hi_max(ice_cat_bounds(2,2)) = 25.0
269
270      !- Type 1 - undeformed ice
271         zc1 = 3./REAL(ice_cat_bounds(1,2)-ice_cat_bounds(1,1)+1)
272         zc2 = 10.0*zc1
273         zc3 = 3.0
274
275         DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
276            zx1 = REAL(jl-1) / REAL(ice_cat_bounds(1,2)-ice_cat_bounds(1,1)+1)
277            hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1.0 + TANH ( zc3 * (zx1 - 1.0 ) ) )
278         END DO
279
280      !- Fill in the hi_max_typ vector, useful in other circumstances
281         DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
282            hi_max_typ(jl,1) = hi_max(jl)
283         END DO
284!        DO jl = ice_cat_bounds(2,1), ice_cat_bounds(2,2)
285!           hi_max_typ(jl-ice_cat_bounds(2,1)+1,2) = hi_max(jl)
286!        END DO
287!        DO jl = ice_cat_bounds(3,1), ice_cat_bounds(3,2)
288!           hi_max_typ(jl-ice_cat_bounds(3,1)+1,3) = hi_max(jl)
289!        END DO
290
291         WRITE(numout,*) ' Thickness category boundaries independently of ice type '
292         WRITE(numout,*) ' hi_max ', hi_max(0:jpl)
293
294         WRITE(numout,*) ' Thickness category boundaries inside ice types '
295         DO jm = 1, jpm
296            WRITE(numout,*) ' Type number ', jm
297            WRITE(numout,*) ' hi_max_typ : ', hi_max_typ(0:ice_ncat_types(jm),jm)
298         END DO
299
300         DO jl = 1, jpl
301            hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) / 2.0
302         END DO
303
304         tn_ice(:,:,:) = t_su(:,:,:)
305
306    END SUBROUTINE lim_itd_ini
307
308#else
309   !!----------------------------------------------------------------------
310   !!   Default option :        Empty module           NO LIM sea-ice model
311   !!----------------------------------------------------------------------
312CONTAINS
313   SUBROUTINE ice_init        ! Empty routine
314   END SUBROUTINE ice_init
315
316   SUBROUTINE lim_itd_ini
317   END SUBROUTINE lim_itd_ini
318#endif
319
320   !!======================================================================
321END MODULE iceini
Note: See TracBrowser for help on using the repository browser.