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/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90 @ 6795

Last change on this file since 6795 was 6795, checked in by davestorkey, 8 years ago

Merge in changes from 3.6 stable branch to rev6770. This update doesn't change results for standard GO6 configurations.
Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r6770 cf. r6692 of /branches/2015/nemo_v3_6_STABLE/NEMOGCM@6794

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