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.
iceistate.F90 in NEMO/branches/UKMO/dev_r10037_GPU/src/ICE – NEMO

source: NEMO/branches/UKMO/dev_r10037_GPU/src/ICE/iceistate.F90 @ 11467

Last change on this file since 11467 was 11467, checked in by andmirek, 5 years ago

Ticket #2197 allocate arrays at the beggining of the run

File size: 29.2 KB
Line 
1MODULE iceistate
2   !!======================================================================
3   !!                     ***  MODULE  iceistate  ***
4   !!   sea-ice : Initialization of ice variables
5   !!======================================================================
6   !! History :  2.0  !  2004-01  (C. Ethe, G. Madec) Original code
7   !!            3.0  !  2007     (M. Vancoppenolle)  Rewrite for ice cats
8   !!            4.0  !  2018     (many people)       SI3 [aka Sea Ice cube]
9   !!----------------------------------------------------------------------
10#if defined key_si3
11   !!----------------------------------------------------------------------
12   !!   'key_si3'                                       SI3 sea-ice model
13   !!----------------------------------------------------------------------
14   !!   ice_istate       :  initialization of diagnostics ice variables
15   !!   ice_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 , ONLY : sst_m, sss_m, ln_ice_embd 
21   USE sbc_ice , ONLY : tn_ice, snwice_mass, snwice_mass_b
22   USE eosbn2         ! equation of state
23   USE domvvl         ! Variable volume
24   USE ice            ! sea-ice variables
25   USE icevar         ! ice_var_salprof
26   !
27   USE in_out_manager ! I/O manager
28   USE iom            ! I/O manager library
29   USE lib_mpp        ! MPP library
30   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
31   USE fldread        ! read input fields
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   ice_istate        ! called by icestp.F90
37   PUBLIC   ice_istate_init   ! called by icestp.F90
38
39   INTEGER , PARAMETER ::   jpfldi = 6           ! maximum number of files to read
40   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness (m)    at T-point
41   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snow thicknes (m)    at T-point
42   INTEGER , PARAMETER ::   jp_ati = 3           ! index of ice fraction (%) at T-point
43   INTEGER , PARAMETER ::   jp_tsu = 4           ! index of ice surface temp (K)    at T-point
44   INTEGER , PARAMETER ::   jp_tmi = 5           ! index of ice temp at T-point
45   INTEGER , PARAMETER ::   jp_smi = 6           ! index of ice sali at T-point
46   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read)
47   !
48   !                             !! ** namelist (namini) **
49   LOGICAL  ::   ln_iceini        ! initialization or not
50   LOGICAL  ::   ln_iceini_file   ! Ice initialization state from 2D netcdf file
51   REAL(wp) ::   rn_thres_sst     ! threshold water temperature for initial sea ice
52   REAL(wp) ::   rn_hts_ini_n     ! initial snow thickness in the north
53   REAL(wp) ::   rn_hts_ini_s     ! initial snow thickness in the south
54   REAL(wp) ::   rn_hti_ini_n     ! initial ice thickness in the north
55   REAL(wp) ::   rn_hti_ini_s     ! initial ice thickness in the south
56   REAL(wp) ::   rn_ati_ini_n     ! initial leads area in the north
57   REAL(wp) ::   rn_ati_ini_s     ! initial leads area in the south
58   REAL(wp) ::   rn_smi_ini_n     ! initial salinity
59   REAL(wp) ::   rn_smi_ini_s     ! initial salinity
60   REAL(wp) ::   rn_tmi_ini_n     ! initial temperature
61   REAL(wp) ::   rn_tmi_ini_s     ! initial temperature
62   
63   !!----------------------------------------------------------------------
64   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
65   !! $Id$
66   !! Software governed by the CeCILL license (see ./LICENSE)
67   !!----------------------------------------------------------------------
68CONTAINS
69
70   SUBROUTINE ice_istate
71      !!-------------------------------------------------------------------
72      !!                    ***  ROUTINE ice_istate  ***
73      !!
74      !! ** Purpose :   defined the sea-ice initial state
75      !!
76      !! ** Method  :   This routine will put some ice where ocean
77      !!                is at the freezing point, then fill in ice
78      !!                state variables using prescribed initial
79      !!                values in the namelist           
80      !!
81      !! ** Steps   :   1) Set initial surface and basal temperatures
82      !!                2) Recompute or read sea ice state variables
83      !!                3) Fill in the ice thickness distribution using gaussian
84      !!                4) Fill in space-dependent arrays for state variables
85      !!                5) snow-ice mass computation
86      !!                6) store before fields
87      !!
88      !! ** Notes   : o_i, t_su, t_s, t_i, sz_i must be filled everywhere, even
89      !!              where there is no ice (clem: I do not know why, is it mandatory?)
90      !!--------------------------------------------------------------------
91      USE scoce, ONLY : zht_i_ini => scr2D1, zat_i_ini => scr2D2, zvt_i_ini => scr2D3, & !data from namelist or nc file
92                       zts_u_ini => scr2D4, zht_s_ini => scr2D5, zsm_i_ini => scr2D6, & 
93                       ztm_i_ini => scr2D7,                                           &
94                       zswitch => scr2D8,                                             & ! ice indicator
95                       z2d => scr2D9
96      USE scice, ONLY : zh_i_ini => scr1i, za_i_ini => scr2i                             !data by cattegories to fill
97      INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices
98      INTEGER  ::   i_hemis, i_fill, jl0   ! local integers
99      REAL(wp) ::   ztmelts, zdh
100      REAL(wp) ::   zarg, zV, zconv, zdv, zfac
101      INTEGER , DIMENSION(4)           ::   itest
102      !--------------------------------------------------------------------
103
104      IF(lwp) WRITE(numout,*)
105      IF(lwp) WRITE(numout,*) 'ice_istate: sea-ice initialization '
106      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
107
108      !--------------------------------------------------------------------
109      ! 1) Set surface and bottom temperatures to initial values
110      !--------------------------------------------------------------------
111      !
112      ! init surface temperature
113      DO jl = 1, jpl
114         t_su   (:,:,jl) = rt0 * tmask(:,:,1)  ! temp at the surface
115         cnd_ice(:,:,jl) = 0._wp               ! initialisation of the effective conductivity at the top of ice/snow (Jules coupling)
116      END DO
117      !
118      ! init basal temperature (considered at freezing point)   [Kelvin]
119      CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
120      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
121
122      IF( ln_iceini ) THEN
123         !-----------------------------------------------------------
124         ! 2) Compute or read sea ice variables ===> single category
125         !-----------------------------------------------------------
126         !
127         !                             !---------------!
128         IF( ln_iceini_file )THEN      ! Read a file   !
129            !                          !---------------!
130            !
131            zht_i_ini(:,:)  = si(jp_hti)%fnow(:,:,1)
132            zht_s_ini(:,:)  = si(jp_hts)%fnow(:,:,1)
133            zat_i_ini(:,:)  = si(jp_ati)%fnow(:,:,1)
134            zts_u_ini(:,:)  = si(jp_tsu)%fnow(:,:,1)
135            ztm_i_ini(:,:)  = si(jp_tmi)%fnow(:,:,1)
136            zsm_i_ini(:,:)  = si(jp_smi)%fnow(:,:,1)
137            !
138            WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 
139            ELSEWHERE                       ; zswitch(:,:) = 0._wp
140            END WHERE
141            zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)
142            !
143            !                          !---------------!
144         ELSE                          ! Read namelist !
145            !                          !---------------!
146            ! no ice if sst <= t-freez + ttest
147            WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst )   ;   zswitch(:,:) = 0._wp 
148            ELSEWHERE                                                                    ;   zswitch(:,:) = tmask(:,:,1)
149            END WHERE
150            !
151            ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
152            WHERE( ff_t(:,:) >= 0._wp )
153               zht_i_ini(:,:) = rn_hti_ini_n * zswitch(:,:)
154               zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:)
155               zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:)
156               zts_u_ini(:,:) = rn_tmi_ini_n * zswitch(:,:)
157               zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:)
158               ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:)
159            ELSEWHERE
160               zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:)
161               zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:)
162               zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:)
163               zts_u_ini(:,:) = rn_tmi_ini_s * zswitch(:,:)
164               zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:)
165               ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:)
166            END WHERE
167            zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)
168            !
169         ENDIF
170         
171         !------------------------------------------------------------------
172         ! 3) Distribute ice concentration and thickness into the categories
173         !------------------------------------------------------------------
174         ! a gaussian distribution for ice concentration is used
175         ! then we check whether the distribution fullfills
176         ! volume and area conservation, positivity and ice categories bounds
177         zh_i_ini(:,:,:) = 0._wp 
178         za_i_ini(:,:,:) = 0._wp
179         !
180         DO jj = 1, jpj
181            DO ji = 1, jpi
182               !
183               IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN
184
185                  ! find which category (jl0) the input ice thickness falls into
186                  jl0 = jpl
187                  DO jl = 1, jpl
188                     IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN
189                        jl0 = jl
190                        CYCLE
191                     ENDIF
192                  END DO
193                  !
194                  itest(:) = 0
195                  i_fill   = jpl + 1                                            !------------------------------------
196                  DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )   ! iterative loop on i_fill categories
197                     !                                                          !------------------------------------
198                     i_fill = i_fill - 1
199                     !
200                     zh_i_ini(ji,jj,:) = 0._wp 
201                     za_i_ini(ji,jj,:) = 0._wp
202                     itest(:) = 0
203                     !
204                     IF ( i_fill == 1 ) THEN      !-- case very thin ice: fill only category 1
205                        zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj)
206                        za_i_ini(ji,jj,1) = zat_i_ini(ji,jj)
207                     ELSE                         !-- case ice is thicker: fill categories >1
208                        ! thickness
209                        DO jl = 1, i_fill-1
210                           zh_i_ini(ji,jj,jl) = hi_mean(jl)
211                        END DO
212                        !
213                        ! concentration
214                        za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl))
215                        DO jl = 1, i_fill - 1
216                           IF( jl /= jl0 )THEN
217                              zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) )
218                              za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2)
219                           ENDIF
220                        END DO
221
222                        ! last category
223                        za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) )
224                        zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) )
225                        zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 ) 
226
227                        ! correction if concentration of upper cat is greater than lower cat
228                        !   (it should be a gaussian around jl0 but sometimes it is not)
229                        IF ( jl0 /= jpl ) THEN
230                           DO jl = jpl, jl0+1, -1
231                              IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN
232                                 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl)
233                                 zh_i_ini(ji,jj,jl    ) = 0._wp
234                                 za_i_ini(ji,jj,jl    ) = 0._wp
235                                 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1)  &
236                                    &                     + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 )
237                              END IF
238                           ENDDO
239                        ENDIF
240                        !
241                     ENDIF
242                     !
243                     ! Compatibility tests
244                     zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) )           ! Test 1: area conservation
245                     IF ( zconv < epsi06 ) itest(1) = 1
246                     !
247                     zconv = ABS(       zat_i_ini(ji,jj)       * zht_i_ini(ji,jj)   &         ! Test 2: volume conservation
248                        &        - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) )
249                     IF ( zconv < epsi06 ) itest(2) = 1
250                     !
251                     IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1           ! Test 3: thickness of the last category is in-bounds ?
252                     !
253                     itest(4) = 1
254                     DO jl = 1, i_fill
255                        IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0                        ! Test 4: positivity of ice concentrations
256                     END DO
257                     !                                                          !----------------------------
258                  END DO                                                        ! end iteration on categories
259                  !                                                             !----------------------------
260                  IF( lwp .AND. SUM(itest) /= 4 ) THEN
261                     WRITE(numout,*)
262                     WRITE(numout,*) ' !!!! ALERT itest is not equal to 4      !!! '
263                     WRITE(numout,*) ' !!!! Something is wrong in the SI3 initialization procedure '
264                     WRITE(numout,*)
265                     WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:)
266                     WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj)
267                     WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj)
268                  ENDIF
269                  !
270               ENDIF
271               !
272            END DO   
273         END DO   
274
275         !---------------------------------------------------------------------
276         ! 4) Fill in sea ice arrays
277         !---------------------------------------------------------------------
278         !
279         ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature
280         DO jl = 1, jpl ! loop over categories
281            DO jj = 1, jpj
282               DO ji = 1, jpi
283                  a_i(ji,jj,jl)  = zswitch(ji,jj) * za_i_ini(ji,jj,jl)                       ! concentration
284                  h_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(ji,jj,jl)                       ! ice thickness
285                  s_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(ji,jj)                         ! salinity
286                  o_i(ji,jj,jl)  = 0._wp                                                     ! age (0 day)
287                  t_su(ji,jj,jl) = zswitch(ji,jj) * zts_u_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp
288                  !
289                  IF( zht_i_ini(ji,jj) > 0._wp )THEN
290                    h_s(ji,jj,jl)= h_i(ji,jj,jl) * ( zht_s_ini(ji,jj) / zht_i_ini(ji,jj) )  ! snow depth
291                  ELSE
292                    h_s(ji,jj,jl)= 0._wp
293                  ENDIF
294                  !
295                  ! This case below should not be used if (h_s/h_i) is ok in namelist
296                  ! In case snow load is in excess that would lead to transformation from snow to ice
297                  ! Then, transfer the snow excess into the ice (different from icethd_dh)
298                  zdh = MAX( 0._wp, ( rhos * h_s(ji,jj,jl) + ( rhoi - rau0 ) * h_i(ji,jj,jl) ) * r1_rau0 ) 
299                  ! recompute h_i, h_s avoiding out of bounds values
300                  h_i(ji,jj,jl) = MIN( hi_max(jl), h_i(ji,jj,jl) + zdh )
301                  h_s(ji,jj,jl) = MAX( 0._wp, h_s(ji,jj,jl) - zdh * rhoi * r1_rhos )
302                  !
303                  ! ice volume, salt content, age content
304                  v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume
305                  v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume
306                  sv_i(ji,jj,jl) = MIN( s_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
307                  oa_i(ji,jj,jl) = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content
308               END DO
309            END DO
310         END DO
311         !
312         IF( nn_icesal /= 2 )  THEN         ! for constant salinity in time
313            CALL ice_var_salprof
314            sv_i = s_i * v_i
315         ENDIF
316         
317         ! Snow temperature and heat content
318         DO jk = 1, nlay_s
319            DO jl = 1, jpl ! loop over categories
320               DO jj = 1, jpj
321                  DO ji = 1, jpi
322                     t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0
323                     ! Snow energy of melting
324                     e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus )
325                     !
326                     ! Mutliply by volume, and divide by number of layers to get heat content in J/m2
327                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
328                  END DO
329               END DO
330            END DO
331         END DO
332         !
333         ! Ice salinity, temperature and heat content
334         DO jk = 1, nlay_i
335            DO jl = 1, jpl ! loop over categories
336               DO jj = 1, jpj
337                  DO ji = 1, jpi
338                     t_i (ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 
339                     sz_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rn_simin
340                     ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
341                     !
342                     ! heat content per unit volume
343                     e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoi * (   rcpi    * ( ztmelts - t_i(ji,jj,jk,jl) )           &
344                        &             + rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0) , -epsi20 )  )   &
345                        &             - rcp  * ( ztmelts - rt0 ) )
346                     !
347                     ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
348                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
349                  END DO
350               END DO
351            END DO
352         END DO
353         !
354         tn_ice (:,:,:) = t_su (:,:,:)
355         t1_ice (:,:,:) = t_i (:,:,1,:)   ! initialisation of 1st layer temp for coupled simu
356
357         ! Melt pond volume and fraction
358         IF ( ln_pnd_CST .OR. ln_pnd_H12 ) THEN   ;   zfac = 1._wp
359         ELSE                                     ;   zfac = 0._wp
360         ENDIF
361         DO jl = 1, jpl
362            a_ip_frac(:,:,jl) = rn_apnd * zswitch(:,:) * zfac
363            h_ip     (:,:,jl) = rn_hpnd * zswitch(:,:) * zfac
364         END DO
365         a_ip(:,:,:) = a_ip_frac(:,:,:) * a_i (:,:,:) 
366         v_ip(:,:,:) = h_ip     (:,:,:) * a_ip(:,:,:)
367         !
368      ELSE ! if ln_iceini=false
369         a_i  (:,:,:) = 0._wp
370         v_i  (:,:,:) = 0._wp
371         v_s  (:,:,:) = 0._wp
372         sv_i (:,:,:) = 0._wp
373         oa_i (:,:,:) = 0._wp
374         h_i  (:,:,:) = 0._wp
375         h_s  (:,:,:) = 0._wp
376         s_i  (:,:,:) = 0._wp
377         o_i  (:,:,:) = 0._wp
378         !
379         e_i(:,:,:,:) = 0._wp
380         e_s(:,:,:,:) = 0._wp
381         !
382         DO jl = 1, jpl
383            DO jk = 1, nlay_i
384               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1)
385            END DO
386            DO jk = 1, nlay_s
387               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1)
388            END DO
389         END DO
390
391         tn_ice (:,:,:) = t_i (:,:,1,:)
392         t1_ice (:,:,:) = t_i (:,:,1,:)   ! initialisation of 1st layer temp for coupled simu
393         
394         a_ip(:,:,:)      = 0._wp
395         v_ip(:,:,:)      = 0._wp
396         a_ip_frac(:,:,:) = 0._wp
397         h_ip     (:,:,:) = 0._wp
398         !
399      ENDIF ! ln_iceini
400      !
401      at_i (:,:) = 0.0_wp
402      DO jl = 1, jpl
403         at_i (:,:) = at_i (:,:) + a_i (:,:,jl)
404      END DO
405      !
406      ! --- set ice velocities --- !
407      u_ice (:,:) = 0._wp
408      v_ice (:,:) = 0._wp
409      !
410      !----------------------------------------------
411      ! 5) Snow-ice mass (case ice is fully embedded)
412      !----------------------------------------------
413      snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3  )   ! snow+ice mass
414      snwice_mass_b(:,:) = snwice_mass(:,:)
415      !
416      IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area
417         !
418         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
419         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
420         !
421         IF( .NOT.ln_linssh ) THEN
422            !
423            WHERE( ht_0(:,:) > 0 )   ;   z2d(:,:) = 1._wp + sshn(:,:)*tmask(:,:,1) / ht_0(:,:)
424            ELSEWHERE                ;   z2d(:,:) = 1._wp   ;   END WHERE
425            !
426            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors               
427               e3t_n(:,:,jk) = e3t_0(:,:,jk) * z2d(:,:)
428               e3t_b(:,:,jk) = e3t_n(:,:,jk)
429               e3t_a(:,:,jk) = e3t_n(:,:,jk)
430            END DO
431            !
432            ! Reconstruction of all vertical scale factors at now and before time-steps
433            ! =========================================================================
434            ! Horizontal scale factor interpolations
435            ! --------------------------------------
436            CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
437            CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
438            CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' )
439            CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' )
440            CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' )
441            ! Vertical scale factor interpolations
442            ! ------------------------------------
443            CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  )
444            CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' )
445            CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' )
446            CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' )
447            CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' )
448            ! t- and w- points depth
449            ! ----------------------
450            !!gm not sure of that....
451            gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)
452            gdepw_n(:,:,1) = 0.0_wp
453            gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)
454            DO jk = 2, jpk
455               gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk  )
456               gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1)
457               gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn (:,:)
458            END DO
459         ENDIF
460      ENDIF
461     
462      !------------------------------------
463      ! 6) store fields at before time-step
464      !------------------------------------
465      ! it is only necessary for the 1st interpolation by Agrif
466      a_i_b  (:,:,:)   = a_i  (:,:,:)
467      e_i_b  (:,:,:,:) = e_i  (:,:,:,:)
468      v_i_b  (:,:,:)   = v_i  (:,:,:)
469      v_s_b  (:,:,:)   = v_s  (:,:,:)
470      e_s_b  (:,:,:,:) = e_s  (:,:,:,:)
471      sv_i_b (:,:,:)   = sv_i (:,:,:)
472      oa_i_b (:,:,:)   = oa_i (:,:,:)
473      u_ice_b(:,:)     = u_ice(:,:)
474      v_ice_b(:,:)     = v_ice(:,:)
475
476!!clem: output of initial state should be written here but it is impossible because
477!!      the ocean and ice are in the same file
478!!      CALL dia_wri_state( 'output.init', nit000 )
479      !
480   END SUBROUTINE ice_istate
481
482
483   SUBROUTINE ice_istate_init
484      !!-------------------------------------------------------------------
485      !!                   ***  ROUTINE ice_istate_init  ***
486      !!       
487      !! ** Purpose :   Definition of initial state of the ice
488      !!
489      !! ** Method  :   Read the namini namelist and check the parameter
490      !!              values called at the first timestep (nit000)
491      !!
492      !! ** input   :  Namelist namini
493      !!
494      !!-----------------------------------------------------------------------------
495      INTEGER ::   ji, jj
496      INTEGER ::   ios, ierr, inum_ice   ! Local integer output status for namelist read
497      INTEGER ::   ifpr, ierror
498      !
499      CHARACTER(len=256) ::  cn_dir          ! Root directory for location of ice files
500      TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi
501      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read
502      !
503      NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  &
504         &             rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, &
505         &             rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s,                             &
506         &             sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, cn_dir
507      !!-----------------------------------------------------------------------------
508      !
509      REWIND( numnam_ice_ref )              ! Namelist namini in reference namelist : Ice initial state
510      READ  ( numnam_ice_ref, namini, IOSTAT = ios, ERR = 901)
511901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namini in reference namelist', lwp )
512      REWIND( numnam_ice_cfg )              ! Namelist namini in configuration namelist : Ice initial state
513      READ  ( numnam_ice_cfg, namini, IOSTAT = ios, ERR = 902 )
514902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namini in configuration namelist', lwp )
515      IF(lwm) WRITE ( numoni, namini )
516      !
517      slf_i(jp_hti) = sn_hti  ;  slf_i(jp_hts) = sn_hts
518      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_tsu) = sn_tsu
519      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_smi) = sn_smi
520      !
521      IF(lwp) THEN                          ! control print
522         WRITE(numout,*)
523         WRITE(numout,*) 'ice_istate_init: ice parameters inititialisation '
524         WRITE(numout,*) '~~~~~~~~~~~~~~~'
525         WRITE(numout,*) '   Namelist namini:'
526         WRITE(numout,*) '      initialization with ice (T) or not (F)                 ln_iceini       = ', ln_iceini
527         WRITE(numout,*) '      ice initialization from a netcdf file                  ln_iceini_file  = ', ln_iceini_file
528         WRITE(numout,*) '      max delta ocean temp. above Tfreeze with initial ice   rn_thres_sst    = ', rn_thres_sst
529         WRITE(numout,*) '      initial snow thickness in the north                    rn_hts_ini_n    = ', rn_hts_ini_n
530         WRITE(numout,*) '      initial snow thickness in the south                    rn_hts_ini_s    = ', rn_hts_ini_s 
531         WRITE(numout,*) '      initial ice thickness  in the north                    rn_hti_ini_n    = ', rn_hti_ini_n
532         WRITE(numout,*) '      initial ice thickness  in the south                    rn_hti_ini_s    = ', rn_hti_ini_s
533         WRITE(numout,*) '      initial ice concentr.  in the north                    rn_ati_ini_n    = ', rn_ati_ini_n
534         WRITE(numout,*) '      initial ice concentr.  in the north                    rn_ati_ini_s    = ', rn_ati_ini_s
535         WRITE(numout,*) '      initial  ice salinity  in the north                    rn_smi_ini_n    = ', rn_smi_ini_n
536         WRITE(numout,*) '      initial  ice salinity  in the south                    rn_smi_ini_s    = ', rn_smi_ini_s
537         WRITE(numout,*) '      initial  ice/snw temp  in the north                    rn_tmi_ini_n    = ', rn_tmi_ini_n
538         WRITE(numout,*) '      initial  ice/snw temp  in the south                    rn_tmi_ini_s    = ', rn_tmi_ini_s
539      ENDIF
540      !
541      IF( ln_iceini_file ) THEN                      ! Ice initialization using input file
542         !
543         ! set si structure
544         ALLOCATE( si(jpfldi), STAT=ierror )
545         IF( ierror > 0 ) THEN
546            CALL ctl_stop( 'Ice_ini in iceistate: unable to allocate si structure' )   ;   RETURN
547         ENDIF
548         !
549         DO ifpr = 1, jpfldi
550            ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) )
551            ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) )
552         END DO
553         !
554         ! fill si with slf_i and control print
555         CALL fld_fill( si, slf_i, cn_dir, 'ice_istate', 'ice istate ini', 'numnam_ice' )
556         !
557         CALL fld_read( nit000, 1, si )                ! input fields provided at the current time-step
558         !
559      ENDIF
560      !
561   END SUBROUTINE ice_istate_init
562
563#else
564   !!----------------------------------------------------------------------
565   !!   Default option :         Empty module         NO SI3 sea-ice model
566   !!----------------------------------------------------------------------
567#endif
568
569   !!======================================================================
570END MODULE iceistate
Note: See TracBrowser for help on using the repository browser.