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.
limistate.F90 in branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90 @ 6696

Last change on this file since 6696 was 6696, checked in by clem, 8 years ago

remove useless and annoying prints

  • Property svn:keywords set to Id
File size: 23.3 KB
Line 
1MODULE limistate
2   !!======================================================================
3   !!                     ***  MODULE  limistate  ***
4   !!              Initialisation of diagnostics ice variables
5   !!======================================================================
6   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code
7   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
8   !!             -   ! 2014    (C. Rousset) add N/S initializations
9   !!----------------------------------------------------------------------
10#if defined key_lim3
11   !!----------------------------------------------------------------------
12   !!   'key_lim3' :                                    LIM3 sea-ice model
13   !!----------------------------------------------------------------------
14   !!   lim_istate      :  Initialisation of diagnostics ice variables
15   !!   lim_istate_init :  initialization of ice state and namelist read
16   !!----------------------------------------------------------------------
17   USE phycst           ! physical constant
18   USE oce              ! dynamics and tracers variables
19   USE dom_oce          ! ocean domain
20   USE sbc_oce          ! Surface boundary condition: ocean fields
21   USE sbc_ice          ! Surface boundary condition: ice fields
22   USE eosbn2           ! equation of state
23   USE ice              ! sea-ice variables
24   USE par_oce          ! ocean parameters
25   USE dom_ice          ! sea-ice domain
26   USE limvar           ! lim_var_salprof
27   USE in_out_manager   ! I/O manager
28   USE lib_mpp          ! MPP library
29   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
30   USE wrk_nemo         ! work arrays
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC   lim_istate      ! routine called by lim_init.F90
36
37   !                          !!** init namelist (namiceini) **
38   REAL(wp) ::   rn_thres_sst   ! threshold water temperature for initial sea ice
39   REAL(wp) ::   rn_hts_ini_n   ! initial snow thickness in the north
40   REAL(wp) ::   rn_hts_ini_s   ! initial snow thickness in the south
41   REAL(wp) ::   rn_hti_ini_n   ! initial ice thickness in the north
42   REAL(wp) ::   rn_hti_ini_s   ! initial ice thickness in the south
43   REAL(wp) ::   rn_ati_ini_n   ! initial leads area in the north
44   REAL(wp) ::   rn_ati_ini_s   ! initial leads area in the south
45   REAL(wp) ::   rn_smi_ini_n   ! initial salinity
46   REAL(wp) ::   rn_smi_ini_s   ! initial salinity
47   REAL(wp) ::   rn_tmi_ini_n   ! initial temperature
48   REAL(wp) ::   rn_tmi_ini_s   ! initial temperature
49
50   LOGICAL  ::  ln_iceini    ! initialization or not
51   !!----------------------------------------------------------------------
52   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)
53   !! $Id$
54   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
55   !!----------------------------------------------------------------------
56CONTAINS
57
58   SUBROUTINE lim_istate
59      !!-------------------------------------------------------------------
60      !!                    ***  ROUTINE lim_istate  ***
61      !!
62      !! ** Purpose :   defined the sea-ice initial state
63      !!
64      !! ** Method  :   
65      !!                This routine will put some ice where ocean
66      !!                is at the freezing point, then fill in ice
67      !!                state variables using prescribed initial
68      !!                values in the namelist           
69      !!
70      !! ** Steps   :   
71      !!                1) Read namelist
72      !!                2) Basal temperature; ice and hemisphere masks
73      !!                3) Fill in the ice thickness distribution using gaussian
74      !!                4) Fill in space-dependent arrays for state variables
75      !!                5) Diagnostic arrays
76      !!                6) Lateral boundary conditions
77      !!
78      !! ** Notes   : o_i, t_su, t_s, t_i, s_i must be filled everywhere, even
79      !!              where there is no ice (clem: I do not know why, is it mandatory?)
80      !!
81      !! History :
82      !!   2.0  !  01-04  (C. Ethe, G. Madec)  Original code
83      !!   3.0  !  2007   (M. Vancoppenolle)   Rewrite for ice cats
84      !!   4.0  !  09-11  (M. Vancoppenolle)   Enhanced version for ice cats
85      !!--------------------------------------------------------------------
86
87      !! * Local variables
88      INTEGER    :: ji, jj, jk, jl             ! dummy loop indices
89      REAL(wp)   :: ztmelts, zdh
90      INTEGER    :: i_hemis, i_fill, jl0 
91      REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv
92      REAL(wp), POINTER, DIMENSION(:)     :: zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini
93      REAL(wp), POINTER, DIMENSION(:,:)   :: zh_i_ini, za_i_ini, zv_i_ini
94      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator
95      INTEGER,  POINTER, DIMENSION(:,:)   :: zhemis   ! hemispheric index
96      !--------------------------------------------------------------------
97
98      CALL wrk_alloc( jpi, jpj, zswitch )
99      CALL wrk_alloc( jpi, jpj, zhemis )
100      CALL wrk_alloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini )
101      CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
102
103      IF(lwp) WRITE(numout,*)
104      IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization '
105      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
106
107      !--------------------------------------------------------------------
108      ! 1) Read namelist
109      !--------------------------------------------------------------------
110
111      CALL lim_istate_init     !  reading the initials parameters of the ice
112
113      ! surface temperature
114      DO jl = 1, jpl ! loop over categories
115         t_su  (:,:,jl) = rt0 * tmask(:,:,1)
116         tn_ice(:,:,jl) = rt0 * tmask(:,:,1)
117      END DO
118
119      ! basal temperature (considered at freezing point)
120      CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
121      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
122
123      IF( ln_iceini ) THEN
124
125      !--------------------------------------------------------------------
126      ! 2) Basal temperature, ice mask and hemispheric index
127      !--------------------------------------------------------------------
128
129      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest
130         DO ji = 1, jpi
131            IF( ( sst_m(ji,jj)  - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN
132               zswitch(ji,jj) = 0._wp * tmask(ji,jj,1)    ! no ice
133            ELSE                                                                                   
134               zswitch(ji,jj) = 1._wp * tmask(ji,jj,1)    !    ice
135            ENDIF
136         END DO
137      END DO
138
139
140      ! Hemispheric index
141      DO jj = 1, jpj
142         DO ji = 1, jpi
143            IF( fcor(ji,jj) >= 0._wp ) THEN   
144               zhemis(ji,jj) = 1 ! Northern hemisphere
145            ELSE
146               zhemis(ji,jj) = 2 ! Southern hemisphere
147            ENDIF
148         END DO
149      END DO
150
151      !--------------------------------------------------------------------
152      ! 3) Initialization of sea ice state variables
153      !--------------------------------------------------------------------
154
155      !-----------------------------
156      ! 3.1) Hemisphere-dependent arrays
157      !-----------------------------
158      ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
159      zht_i_ini(1) = rn_hti_ini_n ; zht_i_ini(2) = rn_hti_ini_s  ! ice thickness
160      zht_s_ini(1) = rn_hts_ini_n ; zht_s_ini(2) = rn_hts_ini_s  ! snow depth
161      zat_i_ini(1) = rn_ati_ini_n ; zat_i_ini(2) = rn_ati_ini_s  ! ice concentration
162      zsm_i_ini(1) = rn_smi_ini_n ; zsm_i_ini(2) = rn_smi_ini_s  ! bulk ice salinity
163      ztm_i_ini(1) = rn_tmi_ini_n ; ztm_i_ini(2) = rn_tmi_ini_s  ! temperature (ice and snow)
164
165      zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume
166
167      !---------------------------------------------------------------------
168      ! 3.2) Distribute ice concentration and thickness into the categories
169      !---------------------------------------------------------------------
170      ! a gaussian distribution for ice concentration is used
171      ! then we check whether the distribution fullfills
172      ! volume and area conservation, positivity and ice categories bounds
173      DO i_hemis = 1, 2
174
175      ztest_1 = 0 ; ztest_2 = 0 ; ztest_3 = 0 ; ztest_4 = 0
176
177      ! note for the great nemo engineers:
178      ! only very few of the WRITE statements are necessary for the reference version
179      ! they were one day useful, but now i personally doubt of their
180      ! potential for bringing anything useful
181
182      DO i_fill = jpl, 1, -1
183         IF ( ( ztest_1 + ztest_2 + ztest_3 + ztest_4 ) .NE. 4 ) THEN
184            !----------------------------
185            ! fill the i_fill categories
186            !----------------------------
187            ! *** 1 category to fill
188            IF ( i_fill .EQ. 1 ) THEN
189               zh_i_ini(1,i_hemis)       = zht_i_ini(i_hemis)
190               za_i_ini(1,i_hemis)       = zat_i_ini(i_hemis)
191               zh_i_ini(2:jpl,i_hemis)   = 0._wp
192               za_i_ini(2:jpl,i_hemis)   = 0._wp
193            ELSE
194
195               ! *** >1 categores to fill
196               !--- Ice thicknesses in the i_fill - 1 first categories
197               DO jl = 1, i_fill - 1
198                  zh_i_ini(jl,i_hemis) = hi_mean(jl)
199               END DO
200               
201               !--- jl0: most likely index where cc will be maximum
202               DO jl = 1, jpl
203                  IF ( ( zht_i_ini(i_hemis) >  hi_max(jl-1) ) .AND. &
204                     & ( zht_i_ini(i_hemis) <= hi_max(jl)   ) ) THEN
205                     jl0 = jl
206                  ENDIF
207               END DO
208               jl0 = MIN(jl0, i_fill)
209               
210               !--- Concentrations
211               za_i_ini(jl0,i_hemis)      = zat_i_ini(i_hemis) / SQRT(REAL(jpl))
212               DO jl = 1, i_fill - 1
213                  IF ( jl .NE. jl0 ) THEN
214                     zsigma               = 0.5 * zht_i_ini(i_hemis)
215                     zarg                 = ( zh_i_ini(jl,i_hemis) - zht_i_ini(i_hemis) ) / zsigma
216                     za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2)
217                  ENDIF
218               END DO
219               
220               zA = 0. ! sum of the areas in the jpl categories
221               DO jl = 1, i_fill - 1
222                 zA = zA + za_i_ini(jl,i_hemis)
223               END DO
224               za_i_ini(i_fill,i_hemis)   = zat_i_ini(i_hemis) - zA ! ice conc in the last category
225               IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp
226         
227               !--- Ice thickness in the last category
228               zV = 0. ! sum of the volumes of the N-1 categories
229               DO jl = 1, i_fill - 1
230                  zV = zV + za_i_ini(jl,i_hemis)*zh_i_ini(jl,i_hemis)
231               END DO
232               zh_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis) 
233               IF ( i_fill .LT. jpl ) zh_i_ini(i_fill+1:jpl, i_hemis) = 0._wp
234
235               !--- volumes
236               zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh_i_ini(:,i_hemis)
237               IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp
238
239            ENDIF ! i_fill
240
241            !---------------------
242            ! Compatibility tests
243            !---------------------
244            ! Test 1: area conservation
245            zA_cons = SUM(za_i_ini(:,i_hemis)) ; zconv = ABS(zat_i_ini(i_hemis) - zA_cons )
246            IF ( zconv .LT. 1.0e-6 ) THEN
247               ztest_1 = 1
248            ELSE
249               ztest_1 = 0
250            ENDIF
251
252            ! Test 2: volume conservation
253            zV_cons = SUM(zv_i_ini(:,i_hemis))
254            zconv = ABS(zvt_i_ini(i_hemis) - zV_cons)
255
256            IF ( zconv .LT. 1.0e-6 ) THEN
257               ztest_2 = 1
258            ELSE
259               ztest_2 = 0
260            ENDIF
261
262            ! Test 3: thickness of the last category is in-bounds ?
263            IF ( zh_i_ini(i_fill, i_hemis) > hi_max(i_fill-1) ) THEN
264               ztest_3 = 1
265            ELSE
266               ztest_3 = 0
267            ENDIF
268
269            ! Test 4: positivity of ice concentrations
270            ztest_4 = 1
271            DO jl = 1, jpl
272               IF ( za_i_ini(jl,i_hemis) .LT. 0._wp ) THEN
273                  ztest_4 = 0
274               ENDIF
275            END DO
276
277         ENDIF ! ztest_1 + ztest_2 + ztest_3 + ztest_4
278 
279         ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4
280
281      END DO ! i_fill
282
283      IF(lwp) THEN
284         WRITE(numout,*) ' ztests : ', ztests
285         IF ( ztests .NE. 4 ) THEN
286            WRITE(numout,*)
287            WRITE(numout,*) ' !!!! ALERT                  !!! '
288            WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure '
289            WRITE(numout,*)
290            WRITE(numout,*) ' *** ztests is not equal to 4 '
291            WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4
292            WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(i_hemis)
293            WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(i_hemis)
294         ENDIF ! ztests .NE. 4
295      ENDIF
296     
297      END DO ! i_hemis
298
299      !---------------------------------------------------------------------
300      ! 3.3) Space-dependent arrays for ice state variables
301      !---------------------------------------------------------------------
302
303      ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature
304      DO jl = 1, jpl ! loop over categories
305         DO jj = 1, jpj
306            DO ji = 1, jpi
307               a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration
308               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))   ! ice thickness
309               ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth
310               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj))     ! salinity
311               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                        ! age (1 day)
312               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp
313
314               ! This case below should not be used if (ht_s/ht_i) is ok in namelist
315               ! In case snow load is in excess that would lead to transformation from snow to ice
316               ! Then, transfer the snow excess into the ice (different from limthd_dh)
317               zdh = MAX( 0._wp, ( rhosn * ht_s(ji,jj,jl) + ( rhoic - rau0 ) * ht_i(ji,jj,jl) ) * r1_rau0 ) 
318               ! recompute ht_i, ht_s avoiding out of bounds values
319               ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh )
320               ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn )
321
322               ! ice volume, salt content, age content
323               v_i(ji,jj,jl)   = ht_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume
324               v_s(ji,jj,jl)   = ht_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume
325               smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
326               oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content
327            END DO
328         END DO
329      END DO
330
331      ! for constant salinity in time
332      IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN
333         CALL lim_var_salprof
334         smv_i = sm_i * v_i
335      ENDIF
336
337      ! Snow temperature and heat content
338      DO jk = 1, nlay_s
339         DO jl = 1, jpl ! loop over categories
340            DO jj = 1, jpj
341               DO ji = 1, jpi
342                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0
343                   ! Snow energy of melting
344                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
345
346                   ! Mutliply by volume, and divide by number of layers to get heat content in J/m2
347                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
348               END DO
349            END DO
350         END DO
351      END DO
352
353      ! Ice salinity, temperature and heat content
354      DO jk = 1, nlay_i
355         DO jl = 1, jpl ! loop over categories
356            DO jj = 1, jpj
357               DO ji = 1, jpi
358                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 
359                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin
360                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
361
362                   ! heat content per unit volume
363                   e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
364                      +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
365                      -   rcp     * ( ztmelts - rt0 ) )
366
367                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
368                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
369               END DO
370            END DO
371         END DO
372      END DO
373
374      tn_ice (:,:,:) = t_su (:,:,:)
375
376      ELSE 
377         ! if ln_iceini=false
378         a_i  (:,:,:) = 0._wp
379         v_i  (:,:,:) = 0._wp
380         v_s  (:,:,:) = 0._wp
381         smv_i(:,:,:) = 0._wp
382         oa_i (:,:,:) = 0._wp
383         ht_i (:,:,:) = 0._wp
384         ht_s (:,:,:) = 0._wp
385         sm_i (:,:,:) = 0._wp
386         o_i  (:,:,:) = 0._wp
387
388         e_i(:,:,:,:) = 0._wp
389         e_s(:,:,:,:) = 0._wp
390
391         DO jl = 1, jpl
392            DO jk = 1, nlay_i
393               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1)
394            END DO
395            DO jk = 1, nlay_s
396               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1)
397            END DO
398         END DO
399     
400      ENDIF ! ln_iceini
401     
402      at_i (:,:) = 0.0_wp
403      DO jl = 1, jpl
404         at_i (:,:) = at_i (:,:) + a_i (:,:,jl)
405      END DO
406      !
407      !--------------------------------------------------------------------
408      ! 4) Global ice variables for output diagnostics                    |
409      !--------------------------------------------------------------------
410      u_ice (:,:)     = 0._wp
411      v_ice (:,:)     = 0._wp
412      stress1_i(:,:)  = 0._wp
413      stress2_i(:,:)  = 0._wp
414      stress12_i(:,:) = 0._wp
415
416      !--------------------------------------------------------------------
417      ! 5) Moments for advection
418      !--------------------------------------------------------------------
419
420      sxopw (:,:) = 0._wp 
421      syopw (:,:) = 0._wp 
422      sxxopw(:,:) = 0._wp 
423      syyopw(:,:) = 0._wp 
424      sxyopw(:,:) = 0._wp
425
426      sxice (:,:,:)  = 0._wp   ;   sxsn (:,:,:)  = 0._wp   ;   sxa  (:,:,:)  = 0._wp
427      syice (:,:,:)  = 0._wp   ;   sysn (:,:,:)  = 0._wp   ;   sya  (:,:,:)  = 0._wp
428      sxxice(:,:,:)  = 0._wp   ;   sxxsn(:,:,:)  = 0._wp   ;   sxxa (:,:,:)  = 0._wp
429      syyice(:,:,:)  = 0._wp   ;   syysn(:,:,:)  = 0._wp   ;   syya (:,:,:)  = 0._wp
430      sxyice(:,:,:)  = 0._wp   ;   sxysn(:,:,:)  = 0._wp   ;   sxya (:,:,:)  = 0._wp
431
432      sxc0  (:,:,:)  = 0._wp   ;   sxe  (:,:,:,:)= 0._wp   
433      syc0  (:,:,:)  = 0._wp   ;   sye  (:,:,:,:)= 0._wp   
434      sxxc0 (:,:,:)  = 0._wp   ;   sxxe (:,:,:,:)= 0._wp   
435      syyc0 (:,:,:)  = 0._wp   ;   syye (:,:,:,:)= 0._wp   
436      sxyc0 (:,:,:)  = 0._wp   ;   sxye (:,:,:,:)= 0._wp   
437
438      sxsal  (:,:,:)  = 0._wp
439      sysal  (:,:,:)  = 0._wp
440      sxxsal (:,:,:)  = 0._wp
441      syysal (:,:,:)  = 0._wp
442      sxysal (:,:,:)  = 0._wp
443
444      sxage  (:,:,:)  = 0._wp
445      syage  (:,:,:)  = 0._wp
446      sxxage (:,:,:)  = 0._wp
447      syyage (:,:,:)  = 0._wp
448      sxyage (:,:,:)  = 0._wp
449
450
451      CALL wrk_dealloc( jpi, jpj, zswitch )
452      CALL wrk_dealloc( jpi, jpj, zhemis )
453      CALL wrk_dealloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini )
454      CALL wrk_dealloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
455
456   END SUBROUTINE lim_istate
457
458   SUBROUTINE lim_istate_init
459      !!-------------------------------------------------------------------
460      !!                   ***  ROUTINE lim_istate_init  ***
461      !!       
462      !! ** Purpose : Definition of initial state of the ice
463      !!
464      !! ** Method : Read the namiceini namelist and check the parameter
465      !!       values called at the first timestep (nit000)
466      !!
467      !! ** input :
468      !!        Namelist namiceini
469      !!
470      !! history :
471      !!  8.5  ! 03-08 (C. Ethe) original code
472      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization
473      !!-----------------------------------------------------------------------------
474      NAMELIST/namiceini/ ln_iceini, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s, rn_hti_ini_n, rn_hti_ini_s,  &
475         &                                      rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s
476      INTEGER :: ios                 ! Local integer output status for namelist read
477      !!-----------------------------------------------------------------------------
478      !
479      REWIND( numnam_ice_ref )              ! Namelist namiceini in reference namelist : Ice initial state
480      READ  ( numnam_ice_ref, namiceini, IOSTAT = ios, ERR = 901)
481901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in reference namelist', lwp )
482
483      REWIND( numnam_ice_cfg )              ! Namelist namiceini in configuration namelist : Ice initial state
484      READ  ( numnam_ice_cfg, namiceini, IOSTAT = ios, ERR = 902 )
485902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in configuration namelist', lwp )
486      IF(lwm) WRITE ( numoni, namiceini )
487
488      ! Define the initial parameters
489      ! -------------------------
490
491      IF(lwp) THEN
492         WRITE(numout,*)
493         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation '
494         WRITE(numout,*) '~~~~~~~~~~~~~~~'
495         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_iceini     = ', ln_iceini
496         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst
497         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n
498         WRITE(numout,*) '   initial snow thickness in the south          rn_hts_ini_s  = ', rn_hts_ini_s 
499         WRITE(numout,*) '   initial ice thickness  in the north          rn_hti_ini_n  = ', rn_hti_ini_n
500         WRITE(numout,*) '   initial ice thickness  in the south          rn_hti_ini_s  = ', rn_hti_ini_s
501         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_n  = ', rn_ati_ini_n
502         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_s  = ', rn_ati_ini_s
503         WRITE(numout,*) '   initial  ice salinity  in the north          rn_smi_ini_n  = ', rn_smi_ini_n
504         WRITE(numout,*) '   initial  ice salinity  in the south          rn_smi_ini_s  = ', rn_smi_ini_s
505         WRITE(numout,*) '   initial  ice/snw temp  in the north          rn_tmi_ini_n  = ', rn_tmi_ini_n
506         WRITE(numout,*) '   initial  ice/snw temp  in the south          rn_tmi_ini_s  = ', rn_tmi_ini_s
507      ENDIF
508
509   END SUBROUTINE lim_istate_init
510
511#else
512   !!----------------------------------------------------------------------
513   !!   Default option :         Empty module          NO LIM sea-ice model
514   !!----------------------------------------------------------------------
515CONTAINS
516   SUBROUTINE lim_istate          ! Empty routine
517   END SUBROUTINE lim_istate
518#endif
519
520   !!======================================================================
521END MODULE limistate
Note: See TracBrowser for help on using the repository browser.