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

source: trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90 @ 7698

Last change on this file since 7698 was 7698, checked in by mocavero, 7 years ago

update trunk with OpenMP parallelization

  • Property svn:keywords set to Id
File size: 30.6 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   !!            3.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 limvar           ! lim_var_salprof
26   !
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   USE fldread          ! read input fields
32   USE iom
33
34   IMPLICIT NONE
35   PRIVATE
36
37   PUBLIC   lim_istate      ! routine called by lim_init.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   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)
49   !! $Id$
50   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
51   !!----------------------------------------------------------------------
52CONTAINS
53
54   SUBROUTINE lim_istate
55      !!-------------------------------------------------------------------
56      !!                    ***  ROUTINE lim_istate  ***
57      !!
58      !! ** Purpose :   defined the sea-ice initial state
59      !!
60      !! ** Method  :   This routine will put some ice where ocean
61      !!                is at the freezing point, then fill in ice
62      !!                state variables using prescribed initial
63      !!                values in the namelist           
64      !!
65      !! ** Steps   :   1) Read namelist
66      !!                2) Basal temperature; ice and hemisphere masks
67      !!                3) Fill in the ice thickness distribution using gaussian
68      !!                4) Fill in space-dependent arrays for state variables
69      !!                5) Diagnostic arrays
70      !!                6) Lateral boundary conditions
71      !!
72      !! ** Notes   : o_i, t_su, t_s, t_i, s_i must be filled everywhere, even
73      !!              where there is no ice (clem: I do not know why, is it mandatory?)
74      !!
75      !! History :
76      !!   2.0  !  01-04  (C. Ethe, G. Madec)  Original code
77      !!   3.0  !  2007   (M. Vancoppenolle)   Rewrite for ice cats
78      !!   4.0  !  09-11  (M. Vancoppenolle)   Enhanced version for ice cats
79      !!--------------------------------------------------------------------
80      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices
81      REAL(wp) :: ztmelts, zdh
82      INTEGER  :: i_hemis, i_fill, jl0 
83      REAL(wp)   :: zarg, zV, zconv, zdv 
84      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator
85      REAL(wp), POINTER, DIMENSION(:,:)   :: zht_i_ini, zat_i_ini, zvt_i_ini            !data from namelist or nc file
86      REAL(wp), POINTER, DIMENSION(:,:)   :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file
87      REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini                         !data by cattegories to fill
88      INTEGER , DIMENSION(4)     :: itest
89      !--------------------------------------------------------------------
90
91      CALL wrk_alloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini )
92      CALL wrk_alloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
93      CALL wrk_alloc( jpi, jpj,      zswitch )
94
95      IF(lwp) WRITE(numout,*)
96      IF(lwp) WRITE(numout,*) 'lim_istate : sea-ice initialization '
97      IF(lwp) WRITE(numout,*) '~~~~~~~~~~ '
98
99      !--------------------------------------------------------------------
100      ! 1) Read namelist
101      !--------------------------------------------------------------------
102      !
103      CALL lim_istate_init
104
105      ! init surface temperature
106      DO jl = 1, jpl
107!$OMP PARALLEL DO schedule(static) private(jj,ji)
108         DO jj = 1, jpj
109            DO ji = 1, jpi
110               t_su  (ji,jj,jl) = rt0 * tmask(ji,jj,1)
111               tn_ice(ji,jj,jl) = rt0 * tmask(ji,jj,1)
112            END DO
113         END DO
114      END DO
115
116      ! init basal temperature (considered at freezing point)
117      CALL eos_fzp( sss_m(:,:), t_bo(:,:) )
118!$OMP PARALLEL DO schedule(static) private(jj,ji)
119      DO jj = 1, jpj
120         DO ji = 1, jpi
121            t_bo(ji,jj) = ( t_bo(ji,jj) + rt0 ) * tmask(ji,jj,1) 
122         END DO
123      END DO
124
125
126      !--------------------------------------------------------------------
127      ! 2) Initialization of sea ice state variables
128      !--------------------------------------------------------------------
129      IF( ln_limini ) THEN
130         !
131         IF( ln_limini_file )THEN
132         !
133!$OMP PARALLEL DO schedule(static) private(jj,ji)
134            DO jj = 1, jpj
135               DO ji = 1, jpi
136                  zht_i_ini(ji,jj)  = si(jp_hti)%fnow(ji,jj,1)
137                  zht_s_ini(ji,jj)  = si(jp_hts)%fnow(ji,jj,1)
138                  zat_i_ini(ji,jj)  = si(jp_ati)%fnow(ji,jj,1)
139                  zts_u_ini(ji,jj)  = si(jp_tsu)%fnow(ji,jj,1)
140                  ztm_i_ini(ji,jj)  = si(jp_tmi)%fnow(ji,jj,1)
141                  zsm_i_ini(ji,jj)  = si(jp_smi)%fnow(ji,jj,1)
142                  !
143                  IF  ( zat_i_ini(ji,jj) > 0._wp ) THEN ; zswitch(ji,jj) = tmask(ji,jj,1) 
144                  ELSE                                ; zswitch(ji,jj) = 0._wp
145                  END IF
146               END DO
147            END DO
148         !
149         ELSE ! ln_limini_file = F
150
151            !--------------------------------------------------------------------
152            ! 3) Basal temperature, ice mask
153            !--------------------------------------------------------------------
154            ! no ice if sst <= t-freez + ttest
155!$OMP PARALLEL
156!$OMP DO schedule(static) private(jj,ji)
157            DO jj = 1, jpj
158               DO ji = 1, jpi
159                  IF ( ( sst_m(ji,jj) - (t_bo(ji,jj) - rt0) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN
160                     zswitch(ji,jj) = 0._wp 
161                  ELSE
162                     zswitch(ji,jj) = tmask(ji,jj,1)
163                  END IF
164               END DO
165            END DO
166
167            !-----------------------------
168            ! 3.1) Hemisphere-dependent arrays
169            !-----------------------------
170            ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array
171!$OMP DO schedule(static) private(jj,ji)
172            DO jj = 1, jpj
173               DO ji = 1, jpi
174                  IF( ff_t(ji,jj) >= 0._wp ) THEN
175                     zht_i_ini(ji,jj) = rn_hti_ini_n * zswitch(ji,jj)
176                     zht_s_ini(ji,jj) = rn_hts_ini_n * zswitch(ji,jj)
177                     zat_i_ini(ji,jj) = rn_ati_ini_n * zswitch(ji,jj)
178                     zts_u_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj)
179                     zsm_i_ini(ji,jj) = rn_smi_ini_n * zswitch(ji,jj)
180                     ztm_i_ini(ji,jj) = rn_tmi_ini_n * zswitch(ji,jj)
181                  ELSE
182                     zht_i_ini(ji,jj) = rn_hti_ini_s * zswitch(ji,jj)
183                     zht_s_ini(ji,jj) = rn_hts_ini_s * zswitch(ji,jj)
184                     zat_i_ini(ji,jj) = rn_ati_ini_s * zswitch(ji,jj)
185                     zts_u_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj)
186                     zsm_i_ini(ji,jj) = rn_smi_ini_s * zswitch(ji,jj)
187                     ztm_i_ini(ji,jj) = rn_tmi_ini_s * zswitch(ji,jj)
188                  ENDIF
189               END DO
190            END DO
191!$OMP END PARALLEL
192            !
193         ENDIF ! ln_limini_file
194         
195!$OMP PARALLEL
196!$OMP DO schedule(static) private(jj,ji)
197         DO jj = 1, jpj
198            DO ji = 1, jpi
199               zvt_i_ini(ji,jj) = zht_i_ini(ji,jj) * zat_i_ini(ji,jj)   ! ice volume
200            END DO
201         END DO
202         !---------------------------------------------------------------------
203         ! 3.2) Distribute ice concentration and thickness into the categories
204         !---------------------------------------------------------------------
205         ! a gaussian distribution for ice concentration is used
206         ! then we check whether the distribution fullfills
207         ! volume and area conservation, positivity and ice categories bounds
208         DO jl = 1, jpl
209!$OMP DO schedule(static) private(jj,ji)
210            DO jj = 1, jpj
211               DO ji = 1, jpi
212                  zh_i_ini(ji,jj,jl) = 0._wp 
213                  za_i_ini(ji,jj,jl) = 0._wp
214               END DO
215            END DO
216         END DO
217         !
218!$OMP DO schedule(static) private(jj,ji,jl0,jl,i_fill,zarg,zV,zdv,zconv,itest)
219         DO jj = 1, jpj
220            DO ji = 1, jpi
221               !
222               IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN
223
224                  !--- jl0: most likely index where cc will be maximum
225                  jl0 = jpl
226                  DO jl = 1, jpl
227                     IF ( ( zht_i_ini(ji,jj) >  hi_max(jl-1) ) .AND. ( zht_i_ini(ji,jj) <= hi_max(jl) ) ) THEN
228                        jl0 = jl
229                        CYCLE
230                     ENDIF
231                  END DO
232                  !
233                  ! initialisation of tests
234                  itest(:)  = 0
235                 
236                  i_fill = jpl + 1                                             !====================================
237                  DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories
238                     ! iteration                                               !====================================
239                     i_fill = i_fill - 1
240
241                     ! initialisation of ice variables for each try
242                     zh_i_ini(ji,jj,:) = 0._wp 
243                     za_i_ini(ji,jj,:) = 0._wp
244                     itest(:) = 0
245                     !
246                     ! *** case very thin ice: fill only category 1
247                     IF ( i_fill == 1 ) THEN
248                        zh_i_ini(ji,jj,1) = zht_i_ini(ji,jj)
249                        za_i_ini(ji,jj,1) = zat_i_ini(ji,jj)
250
251                     ! *** case ice is thicker: fill categories >1
252                     ELSE
253
254                        ! Fill ice thicknesses in the (i_fill-1) cat by hmean
255                        DO jl = 1, i_fill-1
256                           zh_i_ini(ji,jj,jl) = hi_mean(jl)
257                        END DO
258                        !
259                        !--- Concentrations
260                        za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl))
261                        DO jl = 1, i_fill - 1
262                           IF( jl /= jl0 )THEN
263                              zarg               = ( zh_i_ini(ji,jj,jl) - zht_i_ini(ji,jj) ) / ( 0.5_wp * zht_i_ini(ji,jj) )
264                              za_i_ini(ji,jj,jl) = za_i_ini(ji,jj,jl0) * EXP(-zarg**2)
265                           ENDIF
266                        END DO
267                        !
268                        ! Concentration in the last (i_fill) category
269                        za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) )
270
271                        ! Ice thickness in the last (i_fill) category
272                        zV = SUM( za_i_ini(ji,jj,1:i_fill-1) * zh_i_ini(ji,jj,1:i_fill-1) )
273                        zh_i_ini(ji,jj,i_fill) = ( zvt_i_ini(ji,jj) - zV ) / MAX( za_i_ini(ji,jj,i_fill), epsi10 ) 
274
275                        ! clem: correction if concentration of upper cat is greater than lower cat
276                        !       (it should be a gaussian around jl0 but sometimes it is not)
277                        IF ( jl0 /= jpl ) THEN
278                           DO jl = jpl, jl0+1, -1
279                              IF ( za_i_ini(ji,jj,jl) > za_i_ini(ji,jj,jl-1) ) THEN
280                                 zdv = zh_i_ini(ji,jj,jl) * za_i_ini(ji,jj,jl)
281                                 zh_i_ini(ji,jj,jl    ) = 0._wp
282                                 za_i_ini(ji,jj,jl    ) = 0._wp
283                                 za_i_ini(ji,jj,1:jl-1) = za_i_ini(ji,jj,1:jl-1)  &
284                                    &                     + zdv / MAX( REAL(jl-1) * zht_i_ini(ji,jj), epsi10 )
285                              END IF
286                           ENDDO
287                        ENDIF
288                        !
289                     ENDIF ! case ice is thick or thin
290
291                     !---------------------
292                     ! Compatibility tests
293                     !---------------------
294                     ! Test 1: area conservation
295                     zconv = ABS( zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:jpl) ) )
296                     IF ( zconv < epsi06 ) itest(1) = 1
297                     
298                     ! Test 2: volume conservation
299                     zconv = ABS(       zat_i_ini(ji,jj)       * zht_i_ini(ji,jj)   &
300                        &        - SUM( za_i_ini (ji,jj,1:jpl) * zh_i_ini (ji,jj,1:jpl) ) )
301                     IF ( zconv < epsi06 ) itest(2) = 1
302                     
303                     ! Test 3: thickness of the last category is in-bounds ?
304                     IF ( zh_i_ini(ji,jj,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1
305                     
306                     ! Test 4: positivity of ice concentrations
307                     itest(4) = 1
308                     DO jl = 1, i_fill
309                        IF ( za_i_ini(ji,jj,jl) < 0._wp ) itest(4) = 0
310                     END DO
311                     !                                      !============================
312                  END DO                                    ! end iteration on categories
313                  !                                         !============================
314                  !
315                  IF( lwp .AND. SUM(itest) /= 4 ) THEN
316                     WRITE(numout,*)
317                     WRITE(numout,*) ' !!!! ALERT itest is not equal to 4      !!! '
318                     WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure '
319                     WRITE(numout,*)
320                     WRITE(numout,*) ' *** itest_i (i=1,4) = ', itest(:)
321                     WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(ji,jj)
322                     WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(ji,jj)
323                  ENDIF
324               
325               ENDIF !  zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp
326               !
327            END DO   
328         END DO   
329!$OMP END PARALLEL
330
331         !---------------------------------------------------------------------
332         ! 3.3) Space-dependent arrays for ice state variables
333         !---------------------------------------------------------------------
334
335         ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature
336         DO jl = 1, jpl ! loop over categories
337!$OMP PARALLEL DO schedule(static) private(jj,ji)
338            DO jj = 1, jpj
339               DO ji = 1, jpi
340                  a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini(ji,jj,jl)                       ! concentration
341                  ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(ji,jj,jl)                       ! ice thickness
342                  sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(ji,jj)                         ! salinity
343                  o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp                                    ! age (1 day)
344                  t_su(ji,jj,jl)  = zswitch(ji,jj) * zts_u_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp
345
346                  IF( zht_i_ini(ji,jj) > 0._wp )THEN
347                    ht_s(ji,jj,jl)= ht_i(ji,jj,jl) * ( zht_s_ini(ji,jj) / zht_i_ini(ji,jj) )  ! snow depth
348                  ELSE
349                    ht_s(ji,jj,jl)= 0._wp
350                  ENDIF
351
352                  ! This case below should not be used if (ht_s/ht_i) is ok in namelist
353                  ! In case snow load is in excess that would lead to transformation from snow to ice
354                  ! Then, transfer the snow excess into the ice (different from limthd_dh)
355                  zdh = MAX( 0._wp, ( rhosn * ht_s(ji,jj,jl) + ( rhoic - rau0 ) * ht_i(ji,jj,jl) ) * r1_rau0 ) 
356                  ! recompute ht_i, ht_s avoiding out of bounds values
357                  ht_i(ji,jj,jl) = MIN( hi_max(jl), ht_i(ji,jj,jl) + zdh )
358                  ht_s(ji,jj,jl) = MAX( 0._wp, ht_s(ji,jj,jl) - zdh * rhoic * r1_rhosn )
359
360                  ! ice volume, salt content, age content
361                  v_i(ji,jj,jl)   = ht_i(ji,jj,jl) * a_i(ji,jj,jl)              ! ice volume
362                  v_s(ji,jj,jl)   = ht_s(ji,jj,jl) * a_i(ji,jj,jl)              ! snow volume
363                  smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content
364                  oa_i(ji,jj,jl)  = o_i(ji,jj,jl) * a_i(ji,jj,jl)               ! age content
365               END DO
366            END DO
367         END DO
368
369         ! for constant salinity in time
370         IF( nn_icesal == 1 .OR. nn_icesal == 3 )  THEN
371            CALL lim_var_salprof
372            smv_i = sm_i * v_i
373         ENDIF
374           
375!$OMP PARALLEL
376         ! Snow temperature and heat content
377         DO jk = 1, nlay_s
378            DO jl = 1, jpl ! loop over categories
379!$OMP DO schedule(static) private(jj,ji)
380               DO jj = 1, jpj
381                  DO ji = 1, jpi
382                     t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0
383                     ! Snow energy of melting
384                     e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rt0 - t_s(ji,jj,jk,jl) ) + lfus )
385
386                     ! Mutliply by volume, and divide by number of layers to get heat content in J/m2
387                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s
388                  END DO
389               END DO
390            END DO
391         END DO
392
393         ! Ice salinity, temperature and heat content
394         DO jk = 1, nlay_i
395            DO jl = 1, jpl ! loop over categories
396!$OMP DO schedule(static) private(jj,ji)
397               DO jj = 1, jpj
398                  DO ji = 1, jpi
399                     t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rt0 
400                     s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * rn_simin
401                     ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rt0 !Melting temperature in K
402
403                     ! heat content per unit volume
404                     e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
405                        +   lfus    * ( 1._wp - (ztmelts-rt0) / MIN((t_i(ji,jj,jk,jl)-rt0),-epsi20) ) &
406                        -   rcp     * ( ztmelts - rt0 ) )
407
408                     ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2
409                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i
410                  END DO
411               END DO
412            END DO
413         END DO
414
415         DO jl = 1, jpl
416!$OMP DO schedule(static) private(jj,ji)
417            DO jj = 1, jpj
418               DO ji = 1, jpi
419                  tn_ice (ji,jj,jl) = t_su (ji,jj,jl)
420               END DO
421            END DO
422         END DO
423!$OMP END PARALLEL
424
425      ELSE ! if ln_limini=false
426!$OMP PARALLEL
427         DO jl = 1, jpl
428!$OMP DO schedule(static) private(jj,ji)
429            DO jj = 1, jpj
430               DO ji = 1, jpi
431                  a_i  (ji,jj,jl) = 0._wp
432                  v_i  (ji,jj,jl) = 0._wp
433                  v_s  (ji,jj,jl) = 0._wp
434                  smv_i(ji,jj,jl) = 0._wp
435                  oa_i (ji,jj,jl) = 0._wp
436                  ht_i (ji,jj,jl) = 0._wp
437                  ht_s (ji,jj,jl) = 0._wp
438                  sm_i (ji,jj,jl) = 0._wp
439                  o_i  (ji,jj,jl) = 0._wp
440               END DO
441            END DO
442         END DO
443
444         DO jk = 1, nlay_i
445            DO jl = 1, jpl
446!$OMP DO schedule(static) private(jj,ji)
447               DO jj = 1, jpj
448                  DO ji = 1, jpi
449                     e_i(ji,jj,jl,jk) = 0._wp
450                  END DO
451               END DO
452            END DO
453         END DO
454         DO jk = 1, nlay_s
455            DO jl = 1, jpl
456!$OMP DO schedule(static) private(jj,ji)
457               DO jj = 1, jpj
458                  DO ji = 1, jpi
459                     e_s(ji,jj,jl,jk) = 0._wp
460                  END DO
461               END DO
462            END DO
463         END DO
464
465         DO jl = 1, jpl
466            DO jk = 1, nlay_i
467!$OMP DO schedule(static) private(jj,ji)
468               DO jj = 1, jpj
469                  DO ji = 1, jpi
470                     t_i(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1)
471                  END DO
472               END DO
473            END DO
474            DO jk = 1, nlay_s
475!$OMP DO schedule(static) private(jj,ji)
476               DO jj = 1, jpj
477                  DO ji = 1, jpi
478                     t_s(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1)
479                  END DO
480               END DO
481            END DO
482         END DO
483!$OMP END PARALLEL
484
485      ENDIF ! ln_limini
486     
487!$OMP PARALLEL
488!$OMP DO schedule(static) private(jj,ji)
489      DO jj = 1, jpj
490         DO ji = 1, jpi
491            at_i (ji,jj) = 0.0_wp
492         END DO
493      END DO
494      DO jl = 1, jpl
495!$OMP DO schedule(static) private(jj,ji)
496         DO jj = 1, jpj
497            DO ji = 1, jpi
498               at_i (ji,jj) = at_i (ji,jj) + a_i (ji,jj,jl)
499            END DO
500         END DO
501      END DO
502      !
503!$OMP DO schedule(static) private(jj,ji)
504      DO jj = 1, jpj
505         DO ji = 1, jpi
506            !--------------------------------------------------------------------
507            ! 4) Global ice variables for output diagnostics                    |
508            !--------------------------------------------------------------------
509            u_ice (ji,jj)     = 0._wp
510            v_ice (ji,jj)     = 0._wp
511            stress1_i(ji,jj)  = 0._wp
512            stress2_i(ji,jj)  = 0._wp
513            stress12_i(ji,jj) = 0._wp
514
515            !--------------------------------------------------------------------
516            ! 5) Moments for advection
517            !--------------------------------------------------------------------
518
519            sxopw (ji,jj) = 0._wp 
520            syopw (ji,jj) = 0._wp 
521            sxxopw(ji,jj) = 0._wp 
522            syyopw(ji,jj) = 0._wp 
523            sxyopw(ji,jj) = 0._wp
524         END DO
525      END DO
526
527      DO jl = 1, jpl
528!$OMP DO schedule(static) private(jj,ji)
529         DO jj = 1, jpj
530            DO ji = 1, jpi
531               sxice (ji,jj,jl)  = 0._wp   ;   sxsn (ji,jj,jl)  = 0._wp   ;   sxa  (ji,jj,jl)  = 0._wp
532               syice (ji,jj,jl)  = 0._wp   ;   sysn (ji,jj,jl)  = 0._wp   ;   sya  (ji,jj,jl)  = 0._wp
533               sxxice(ji,jj,jl)  = 0._wp   ;   sxxsn(ji,jj,jl)  = 0._wp   ;   sxxa (ji,jj,jl)  = 0._wp
534               syyice(ji,jj,jl)  = 0._wp   ;   syysn(ji,jj,jl)  = 0._wp   ;   syya (ji,jj,jl)  = 0._wp
535               sxyice(ji,jj,jl)  = 0._wp   ;   sxysn(ji,jj,jl)  = 0._wp   ;   sxya (ji,jj,jl)  = 0._wp
536
537               sxc0  (ji,jj,jl)  = 0._wp   
538               syc0  (ji,jj,jl)  = 0._wp   
539               sxxc0 (ji,jj,jl)  = 0._wp   
540               syyc0 (ji,jj,jl)  = 0._wp   
541               sxyc0 (ji,jj,jl)  = 0._wp   
542
543               sxsal  (ji,jj,jl)  = 0._wp
544               sysal  (ji,jj,jl)  = 0._wp
545               sxxsal (ji,jj,jl)  = 0._wp
546               syysal (ji,jj,jl)  = 0._wp
547               sxysal (ji,jj,jl)  = 0._wp
548
549               sxage  (ji,jj,jl)  = 0._wp
550               syage  (ji,jj,jl)  = 0._wp
551               sxxage (ji,jj,jl)  = 0._wp
552               syyage (ji,jj,jl)  = 0._wp
553               sxyage (ji,jj,jl)  = 0._wp
554            END DO
555         END DO
556      END DO
557
558      DO jl = 1, jpl
559         DO jk = 1, nlay_i
560!$OMP DO schedule(static) private(jj,ji)
561            DO jj = 1, jpj
562               DO ji = 1, jpi
563                  sxe  (ji,jj,jk,jl)= 0._wp
564                  sye  (ji,jj,jk,jl)= 0._wp
565                  sxxe (ji,jj,jk,jl)= 0._wp
566                  syye (ji,jj,jk,jl)= 0._wp
567                  sxye (ji,jj,jk,jl)= 0._wp
568               END DO
569            END DO
570         END DO
571      END DO
572!$OMP END PARALLEL
573
574
575!!!clem
576!!      ! Output the initial state and forcings
577!!      CALL dia_wri_state( 'output.init', nit000 )
578!!!     
579
580      CALL wrk_dealloc( jpi, jpj, jpl, zh_i_ini,  za_i_ini )
581      CALL wrk_dealloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini )
582      CALL wrk_dealloc( jpi, jpj,      zswitch )
583
584   END SUBROUTINE lim_istate
585
586   SUBROUTINE lim_istate_init
587      !!-------------------------------------------------------------------
588      !!                   ***  ROUTINE lim_istate_init  ***
589      !!       
590      !! ** Purpose : Definition of initial state of the ice
591      !!
592      !! ** Method : Read the namiceini namelist and check the parameter
593      !!       values called at the first timestep (nit000)
594      !!
595      !! ** input :
596      !!        Namelist namiceini
597      !!
598      !! history :
599      !!  8.5  ! 03-08 (C. Ethe) original code
600      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization
601      !!-----------------------------------------------------------------------------
602      !
603      INTEGER :: ios,ierr,inum_ice                 ! Local integer output status for namelist read
604      INTEGER :: ji,jj
605      INTEGER :: ifpr, ierror
606      !
607      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ice files
608      TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi
609      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read
610      !
611      NAMELIST/namiceini/ ln_limini, ln_limini_file, rn_thres_sst, rn_hts_ini_n, rn_hts_ini_s,  &
612         &                rn_hti_ini_n, rn_hti_ini_s, rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, &
613         &                rn_smi_ini_s, rn_tmi_ini_n, rn_tmi_ini_s,                             &
614         &                sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, cn_dir
615      !!-----------------------------------------------------------------------------
616      !
617      REWIND( numnam_ice_ref )              ! Namelist namiceini in reference namelist : Ice initial state
618      READ  ( numnam_ice_ref, namiceini, IOSTAT = ios, ERR = 901)
619901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in reference namelist', lwp )
620
621      REWIND( numnam_ice_cfg )              ! Namelist namiceini in configuration namelist : Ice initial state
622      READ  ( numnam_ice_cfg, namiceini, IOSTAT = ios, ERR = 902 )
623902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in configuration namelist', lwp )
624      IF(lwm) WRITE ( numoni, namiceini )
625
626      slf_i(jp_hti) = sn_hti  ;  slf_i(jp_hts) = sn_hts
627      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_tsu) = sn_tsu
628      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_smi) = sn_smi
629
630      ! Define the initial parameters
631      ! -------------------------
632
633      IF(lwp) THEN
634         WRITE(numout,*)
635         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation '
636         WRITE(numout,*) '~~~~~~~~~~~~~~~'
637         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini     = ', ln_limini
638         WRITE(numout,*) '   ice initialization from a netcdf file      ln_limini_file  = ', ln_limini_file
639         WRITE(numout,*) '   threshold water temp. for initial sea-ice    rn_thres_sst  = ', rn_thres_sst
640         WRITE(numout,*) '   initial snow thickness in the north          rn_hts_ini_n  = ', rn_hts_ini_n
641         WRITE(numout,*) '   initial snow thickness in the south          rn_hts_ini_s  = ', rn_hts_ini_s 
642         WRITE(numout,*) '   initial ice thickness  in the north          rn_hti_ini_n  = ', rn_hti_ini_n
643         WRITE(numout,*) '   initial ice thickness  in the south          rn_hti_ini_s  = ', rn_hti_ini_s
644         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_n  = ', rn_ati_ini_n
645         WRITE(numout,*) '   initial ice concentr.  in the north          rn_ati_ini_s  = ', rn_ati_ini_s
646         WRITE(numout,*) '   initial  ice salinity  in the north          rn_smi_ini_n  = ', rn_smi_ini_n
647         WRITE(numout,*) '   initial  ice salinity  in the south          rn_smi_ini_s  = ', rn_smi_ini_s
648         WRITE(numout,*) '   initial  ice/snw temp  in the north          rn_tmi_ini_n  = ', rn_tmi_ini_n
649         WRITE(numout,*) '   initial  ice/snw temp  in the south          rn_tmi_ini_s  = ', rn_tmi_ini_s
650      ENDIF
651
652      IF( ln_limini_file ) THEN                      ! Ice initialization using input file
653         !
654         ! set si structure
655         ALLOCATE( si(jpfldi), STAT=ierror )
656         IF( ierror > 0 ) THEN
657            CALL ctl_stop( 'Ice_ini in limistate: unable to allocate si structure' )   ;   RETURN
658         ENDIF
659
660         DO ifpr = 1, jpfldi
661            ALLOCATE( si(ifpr)%fnow(jpi,jpj,1) )
662            ALLOCATE( si(ifpr)%fdta(jpi,jpj,1,2) )
663         END DO
664
665         ! fill si with slf_i and control print
666         CALL fld_fill( si, slf_i, cn_dir, 'lim_istate', 'lim istate ini', 'numnam_ice' )
667
668         CALL fld_read( nit000, 1, si )                ! input fields provided at the current time-step
669
670      ENDIF
671
672   END SUBROUTINE lim_istate_init
673
674#else
675   !!----------------------------------------------------------------------
676   !!   Default option :         Empty module          NO LIM sea-ice model
677   !!----------------------------------------------------------------------
678CONTAINS
679   SUBROUTINE lim_istate          ! Empty routine
680   END SUBROUTINE lim_istate
681#endif
682
683   !!======================================================================
684END MODULE limistate
Note: See TracBrowser for help on using the repository browser.