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.
limvar.F90 in branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90 @ 2833

Last change on this file since 2833 was 2777, checked in by smasson, 13 years ago

LIM3 compiling and (partly?) running in v3_3_1, see ticket#817
  • Property svn:keywords set to Id
File size: 22.4 KB
Line 
1MODULE limvar
2   !!======================================================================
3   !!                       ***  MODULE limvar ***
4   !!                 Different sets of ice model variables
5   !!                   how to switch from one to another
6   !!
7   !!                 There are three sets of variables
8   !!                 VGLO : global variables of the model
9   !!                        - v_i (jpi,jpj,jpl)
10   !!                        - v_s (jpi,jpj,jpl)
11   !!                        - a_i (jpi,jpj,jpl)
12   !!                        - t_s (jpi,jpj,jpl)
13   !!                        - e_i (jpi,jpj,nlay_i,jpl)
14   !!                        - smv_i(jpi,jpj,jpl)
15   !!                        - oa_i (jpi,jpj,jpl)
16   !!                 VEQV : equivalent variables sometimes used in the model
17   !!                        - ht_i(jpi,jpj,jpl)
18   !!                        - ht_s(jpi,jpj,jpl)
19   !!                        - t_i (jpi,jpj,nlay_i,jpl)
20   !!                        ...
21   !!                 VAGG : aggregate variables, averaged/summed over all
22   !!                        thickness categories
23   !!                        - vt_i(jpi,jpj)
24   !!                        - vt_s(jpi,jpj)
25   !!                        - at_i(jpi,jpj)
26   !!                        - et_s(jpi,jpj)  !total snow heat content
27   !!                        - et_i(jpi,jpj)  !total ice thermal content
28   !!                        - smt_i(jpi,jpj) !mean ice salinity
29   !!                        - ot_i(jpi,jpj)  !average ice age
30   !!======================================================================
31   !! History :   -   ! 2006-01 (M. Vancoppenolle) Original code
32   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
33   !!----------------------------------------------------------------------
34#if defined key_lim3
35   !!----------------------------------------------------------------------
36   !!   'key_lim3'                                      LIM3 sea-ice model
37   !!----------------------------------------------------------------------
38   !!   lim_var_agg       :
39   !!   lim_var_glo2eqv   :
40   !!   lim_var_eqv2glo   :
41   !!   lim_var_salprof   :
42   !!   lim_var_salprof1d :
43   !!   lim_var_bv        :
44   !!----------------------------------------------------------------------
45   USE par_oce          ! ocean parameters
46   USE phycst           ! physical constants (ocean directory)
47   USE sbc_oce          ! Surface boundary condition: ocean fields
48   USE ice              ! LIM variables
49   USE par_ice          ! LIM parameters
50   USE dom_ice          ! LIM domain
51   USE thd_ice          ! LIM thermodynamics
52   USE in_out_manager   ! I/O manager
53   USE lib_mpp         ! MPP library
54
55   IMPLICIT NONE
56   PRIVATE
57
58   PUBLIC   lim_var_agg          !
59   PUBLIC   lim_var_glo2eqv      !
60   PUBLIC   lim_var_eqv2glo      !
61   PUBLIC   lim_var_salprof      !
62   PUBLIC   lim_var_bv           !
63   PUBLIC   lim_var_salprof1d    !
64
65   REAL(wp) ::   eps20 = 1.e-20_wp   ! module constants
66   REAL(wp) ::   eps16 = 1.e-16_wp   !    -       -
67   REAL(wp) ::   eps13 = 1.e-13_wp   !    -       -
68   REAL(wp) ::   eps10 = 1.e-10_wp   !    -       -
69   REAL(wp) ::   eps06 = 1.e-06_wp   !    -       -
70   REAL(wp) ::   zzero = 0.e0        !    -       -
71   REAL(wp) ::   zone  = 1.e0        !    -       -
72
73   !!----------------------------------------------------------------------
74   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
75   !! $Id$
76   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
77   !!----------------------------------------------------------------------
78CONTAINS
79
80   SUBROUTINE lim_var_agg( kn )
81      !!------------------------------------------------------------------
82      !!                ***  ROUTINE lim_var_agg  ***
83      !!
84      !! ** Purpose :   aggregates ice-thickness-category variables to all-ice variables
85      !!              i.e. it turns VGLO into VAGG
86      !! ** Method  :
87      !!
88      !! ** Arguments : n = 1, at_i vt_i only
89      !!                n = 2 everything
90      !!
91      !! note : you could add an argument when you need only at_i, vt_i
92      !!        and when you need everything
93      !!------------------------------------------------------------------
94      INTEGER, INTENT( in ) ::   kn     ! =1 at_i & vt only ; = what is needed
95      !
96      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
97      REAL(wp) ::   zinda
98      !!------------------------------------------------------------------
99
100      !--------------------
101      ! Compute variables
102      !--------------------
103      vt_i (:,:) = 0._wp
104      vt_s (:,:) = 0._wp
105      at_i (:,:) = 0._wp
106      ato_i(:,:) = 1._wp
107      !
108      DO jl = 1, jpl
109         DO jj = 1, jpj
110            DO ji = 1, jpi
111               !
112               vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume
113               vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume
114               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration
115               !
116               zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 
117               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , eps16 ) * zinda  ! ice thickness
118            END DO
119         END DO
120      END DO
121
122      DO jj = 1, jpj
123         DO ji = 1, jpi
124            ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp )   ! open water fraction
125         END DO
126      END DO
127
128      IF( kn > 1 ) THEN
129         et_s (:,:) = 0._wp
130         ot_i (:,:) = 0._wp
131         smt_i(:,:) = 0._wp
132         et_i (:,:) = 0._wp
133         !
134         DO jl = 1, jpl
135            DO jj = 1, jpj
136               DO ji = 1, jpi
137                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content
138                  zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - 0.10 ) ) 
139                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , eps13 ) * zinda   ! ice salinity
140                  zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 
141                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , eps13 ) * zinda   ! ice age
142               END DO
143            END DO
144         END DO
145         !
146         DO jl = 1, jpl
147            DO jk = 1, nlay_i
148               et_i(:,:) = et_i(:,:) + e_i(:,:,jk,jl)       ! ice heat content
149            END DO
150         END DO
151         !
152      ENDIF
153      !
154   END SUBROUTINE lim_var_agg
155
156
157   SUBROUTINE lim_var_glo2eqv
158      !!------------------------------------------------------------------
159      !!                ***  ROUTINE lim_var_glo2eqv ***
160      !!
161      !! ** Purpose :   computes equivalent variables as function of global variables
162      !!              i.e. it turns VGLO into VEQV
163      !!------------------------------------------------------------------
164      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
165      REAL(wp) ::   zq_i, zaaa, zbbb, zccc, zdiscrim     ! local scalars
166      REAL(wp) ::   ztmelts, zindb, zq_s, zfac1, zfac2   !   -      -
167      !!------------------------------------------------------------------
168
169      !-------------------------------------------------------
170      ! Ice thickness, snow thickness, ice salinity, ice age
171      !-------------------------------------------------------
172      DO jl = 1, jpl
173         DO jj = 1, jpj
174            DO ji = 1, jpi
175               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) ) )   !0 if no ice and 1 if yes
176               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb
177               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb
178               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb
179            END DO
180         END DO
181      END DO
182
183      IF(  num_sal == 2  .OR.  num_sal == 4  )THEN
184         DO jl = 1, jpl
185            DO jj = 1, jpj
186               DO ji = 1, jpi
187                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) ) )   !0 if no ice and 1 if yes
188                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , eps10 ) * zindb
189               END DO
190            END DO
191         END DO
192      ENDIF
193
194      CALL lim_var_salprof      ! salinity profile
195
196      !-------------------
197      ! Ice temperatures
198      !-------------------
199!CDIR NOVERRCHK
200      DO jl = 1, jpl
201!CDIR NOVERRCHK
202         DO jk = 1, nlay_i
203!CDIR NOVERRCHK
204            DO jj = 1, jpj
205!CDIR NOVERRCHK
206               DO ji = 1, jpi
207                  !                                                              ! Energy of melting q(S,T) [J.m-3]
208                  zq_i    = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , eps06 ) * REAL(nlay_i,wp) 
209                  zindb   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) ) )     ! zindb = 0 if no ice and 1 if yes
210                  zq_i    = zq_i * unit_fac * zindb                              !convert units
211                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt                       ! Ice layer melt temperature
212                  !
213                  zaaa       =  cpic                  ! Conversion q(S,T) -> T (second order equation)
214                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i / rhoic - lfus
215                  zccc       =  lfus * (ztmelts-rtt)
216                  zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) )
217                  t_i(ji,jj,jk,jl) = rtt + zindb *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
218                  t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) )       ! 100-rtt < t_i < rtt
219               END DO
220            END DO
221         END DO
222      END DO
223
224      !--------------------
225      ! Snow temperatures
226      !--------------------
227      zfac1 = 1._wp / ( rhosn * cpic )
228      zfac2 = lfus / cpic 
229      DO jl = 1, jpl
230         DO jk = 1, nlay_s
231            DO jj = 1, jpj
232               DO ji = 1, jpi
233                  !Energy of melting q(S,T) [J.m-3]
234                  zq_s  = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , eps06 ) ) * REAL(nlay_s,wp)
235                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) ) )     ! zindb = 0 if no ice and 1 if yes
236                  zq_s  = zq_s * unit_fac * zindb                                    ! convert units
237                  !
238                  t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 )
239                  t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) )     ! 100-rtt < t_i < rtt
240               END DO
241            END DO
242         END DO
243      END DO
244
245      !-------------------
246      ! Mean temperature
247      !-------------------
248      tm_i(:,:) = 0._wp
249      DO jl = 1, jpl
250         DO jk = 1, nlay_i
251            DO jj = 1, jpj
252               DO ji = 1, jpi
253                  zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , -a_i(ji,jj,jl) ) )  )   &
254                     &  * (  1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) ) )  )
255                  tm_i(ji,jj) = tm_i(ji,jj) + t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   &
256                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , eps10 )  )
257               END DO
258            END DO
259         END DO
260      END DO
261      !
262   END SUBROUTINE lim_var_glo2eqv
263
264
265   SUBROUTINE lim_var_eqv2glo
266      !!------------------------------------------------------------------
267      !!                ***  ROUTINE lim_var_eqv2glo ***
268      !!
269      !! ** Purpose :   computes global variables as function of equivalent variables
270      !!                i.e. it turns VEQV into VGLO
271      !! ** Method  :
272      !!
273      !! ** History :  (01-2006) Martin Vancoppenolle, UCL-ASTR
274      !!------------------------------------------------------------------
275      !
276      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:)
277      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:)
278      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
279      oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:)
280      !
281   END SUBROUTINE lim_var_eqv2glo
282
283
284   SUBROUTINE lim_var_salprof
285      !!------------------------------------------------------------------
286      !!                ***  ROUTINE lim_var_salprof ***
287      !!
288      !! ** Purpose :   computes salinity profile in function of bulk salinity     
289      !!
290      !! ** Method  : If bulk salinity greater than s_i_1,
291      !!              the profile is assumed to be constant (S_inf)
292      !!              If bulk salinity lower than s_i_0,
293      !!              the profile is linear with 0 at the surface (S_zero)
294      !!              If it is between s_i_0 and s_i_1, it is a
295      !!              alpha-weighted linear combination of s_inf and s_zero
296      !!
297      !! ** References : Vancoppenolle et al., 2007 (in preparation)
298      !!------------------------------------------------------------------
299      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
300      USE wrk_nemo, ONLY:   wrk_3d_3, wrk_3d_4 
301      INTEGER  ::   ji, jj, jk, jl   ! dummy loop index
302      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac, zsal      ! local scalar
303      REAL(wp) ::   zind0, zind01, zindbal, zargtemp , zs_zero   !   -      -
304      !
305      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha   ! 3D pointer
306      !!------------------------------------------------------------------
307
308      IF( wrk_in_use( 3, 3,4 ) ) THEN
309         CALL ctl_stop( 'lim_var_salprof: requested workspace arrays unavailable' )   ;   RETURN
310      END IF
311
312      z_slope_s => wrk_3d_3(:,:,1:jpl)   ! slope of the salinity profile
313      zalpha    => wrk_3d_4(:,:,1:jpl)   ! weight factor for s between s_i_0 and s_i_1
314
315      !---------------------------------------
316      ! Vertically constant, constant in time
317      !---------------------------------------
318      IF( num_sal == 1 )   s_i(:,:,:,:) = bulk_sal
319
320      !-----------------------------------
321      ! Salinity profile, varying in time
322      !-----------------------------------
323
324      IF(   num_sal == 2  .OR.   num_sal == 4   ) THEN
325         !
326         DO jk = 1, nlay_i
327            s_i(:,:,jk,:)  = sm_i(:,:,:)
328         END DO
329         !
330         DO jl = 1, jpl                               ! Slope of the linear profile
331            DO jj = 1, jpj
332               DO ji = 1, jpi
333                  z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01 , ht_i(ji,jj,jl) )
334               END DO
335            END DO
336         END DO
337         !
338         dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )       ! Weighting factor between zs_zero and zs_inf
339         dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
340
341         zalpha(:,:,:) = 0._wp
342         DO jl = 1, jpl
343            DO jj = 1, jpj
344               DO ji = 1, jpi
345                  ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise
346                  zind0  = MAX( 0.0   , SIGN( 1.0  , s_i_0 - sm_i(ji,jj,jl) ) ) 
347                  ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws
348                  zind01 = ( 1.0 - zind0 ) * MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i(ji,jj,jl) ) ) 
349                  ! If 2.sm_i GE sss_m then zindbal = 1
350                  zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
351                  zalpha(ji,jj,jl) = zind0  * 1.0 + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 )
352                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1.0 - zindbal )
353               END DO
354            END DO
355         END DO
356
357         dummy_fac = 1._wp / nlay_i                   ! Computation of the profile
358         DO jl = 1, jpl
359            DO jk = 1, nlay_i
360               DO jj = 1, jpj
361                  DO ji = 1, jpi
362                     !                                      ! linear profile with 0 at the surface
363                     zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * dummy_fac
364                     !                                      ! weighting the profile
365                     s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl)
366                  END DO ! ji
367               END DO ! jj
368            END DO ! jk
369         END DO ! jl
370
371      ENDIF ! num_sal
372
373      !-------------------------------------------------------
374      ! Vertically varying salinity profile, constant in time
375      !-------------------------------------------------------
376
377      IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
378         !
379         sm_i(:,:,:) = 2.30_wp
380         !
381         DO jl = 1, jpl
382!CDIR NOVERRCHK
383            DO jk = 1, nlay_i
384               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
385               zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  )
386               s_i(:,:,jk,jl) =  zsal
387            END DO
388         END DO
389
390      ENDIF ! num_sal
391      !
392      IF( wrk_not_released(3, 3,4) )   CALL ctl_stop('lim_var_salprof: failed to release workspace arrays.')
393      !
394   END SUBROUTINE lim_var_salprof
395
396
397   SUBROUTINE lim_var_bv
398      !!------------------------------------------------------------------
399      !!                ***  ROUTINE lim_var_bv ***
400      !!
401      !! ** Purpose :   computes mean brine volume (%) in sea ice
402      !!
403      !! ** Method  : e = - 0.054 * S (ppt) / T (C)
404      !!
405      !! References : Vancoppenolle et al., JGR, 2007
406      !!------------------------------------------------------------------
407      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
408      REAL(wp) ::   zbvi, zindb      ! local scalars
409      !!------------------------------------------------------------------
410      !
411      bv_i(:,:) = 0._wp
412      DO jl = 1, jpl
413         DO jk = 1, nlay_i
414            DO jj = 1, jpj
415               DO ji = 1, jpi
416                  zindb = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes
417                  zbvi  = - zindb * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - 273.15 , eps13 )   &
418                     &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp)
419                  bv_i(ji,jj) = bv_i(ji,jj) + zbvi  / MAX( vt_i(ji,jj) , eps13 )
420               END DO
421            END DO
422         END DO
423      END DO
424      !
425   END SUBROUTINE lim_var_bv
426
427
428   SUBROUTINE lim_var_salprof1d( kideb, kiut )
429      !!-------------------------------------------------------------------
430      !!                  ***  ROUTINE lim_thd_salprof1d  ***
431      !!
432      !! ** Purpose :   1d computation of the sea ice salinity profile
433      !!                Works with 1d vectors and is used by thermodynamic modules
434      !!-------------------------------------------------------------------
435      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
436      USE wrk_nemo, ONLY:   wrk_1d_4
437      INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index
438      !
439      INTEGER  ::   ji, jk    ! dummy loop indices
440      INTEGER  ::   zji, zjj  ! local integers
441      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal   ! local scalars
442      REAL(wp) ::   zalpha, zind0, zind01, zindbal, zs_zero              !   -      -
443      !
444      REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s
445      !!---------------------------------------------------------------------
446
447      IF(  wrk_in_use(1, 4)  ) THEN
448         CALL ctl_stop('lim_var_salprof1d : requestead workspace arrays unavailable.')   ;   RETURN
449      END IF
450      ! Set-up pointers to sub-arrays of workspace arrays
451      z_slope_s  =>  wrk_1d_4 (1:jpij)
452
453      !---------------------------------------
454      ! Vertically constant, constant in time
455      !---------------------------------------
456      IF( num_sal == 1 )   s_i_b(:,:) = bulk_sal
457
458      !------------------------------------------------------
459      ! Vertically varying salinity profile, varying in time
460      !------------------------------------------------------
461
462      IF(  num_sal == 2  .OR.  num_sal == 4  ) THEN
463         !
464         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero
465            z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( 0.01 , ht_i_b(ji) )
466         END DO
467
468         ! Weighting factor between zs_zero and zs_inf
469         !---------------------------------------------
470         dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )
471         dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
472         dummy_fac2 = 1._wp / REAL(nlay_i,wp)
473
474!CDIR NOVERRCHK
475         DO jk = 1, nlay_i
476!CDIR NOVERRCHK
477            DO ji = kideb, kiut
478               zji =  MOD( npb(ji) - 1 , jpi ) + 1
479               zjj =     ( npb(ji) - 1 ) / jpi + 1
480               ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise
481               zind0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_b(ji) ) ) 
482               ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws
483               zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_b(ji) ) ) 
484               ! if 2.sm_i GE sss_m then zindbal = 1
485               zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_b(ji) - sss_m(zji,zjj) ) )
486               !
487               zalpha = (  zind0 + zind01 * ( sm_i_b(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zindbal )
488               !
489               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_b(ji) * dummy_fac2
490               ! weighting the profile
491               s_i_b(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_b(ji)
492            END DO ! ji
493         END DO ! jk
494
495      ENDIF ! num_sal
496
497      !-------------------------------------------------------
498      ! Vertically varying salinity profile, constant in time
499      !-------------------------------------------------------
500
501      IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
502         !
503         sm_i_b(:) = 2.30_wp
504         !
505!CDIR NOVERRCHK
506         DO jk = 1, nlay_i
507            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
508            zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  )
509            DO ji = kideb, kiut
510               s_i_b(ji,jk) = zsal
511            END DO
512         END DO
513         !
514      ENDIF
515      !
516      IF( wrk_not_released(1, 4) )   CALL ctl_stop( 'lim_var_salprof1d : failed to release workspace arrays' )
517      !
518   END SUBROUTINE lim_var_salprof1d
519
520#else
521   !!----------------------------------------------------------------------
522   !!   Default option         Dummy module          NO  LIM3 sea-ice model
523   !!----------------------------------------------------------------------
524CONTAINS
525   SUBROUTINE lim_var_agg          ! Empty routines
526   END SUBROUTINE lim_var_agg
527   SUBROUTINE lim_var_glo2eqv      ! Empty routines
528   END SUBROUTINE lim_var_glo2eqv
529   SUBROUTINE lim_var_eqv2glo      ! Empty routines
530   END SUBROUTINE lim_var_eqv2glo
531   SUBROUTINE lim_var_salprof      ! Empty routines
532   END SUBROUTINE lim_var_salprof
533   SUBROUTINE lim_var_bv           ! Emtpy routines
534   END SUBROUTINE lim_var_bv
535   SUBROUTINE lim_var_salprof1d    ! Emtpy routines
536   END SUBROUTINE lim_var_salprof1d
537#endif
538
539   !!======================================================================
540END MODULE limvar
Note: See TracBrowser for help on using the repository browser.