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.
limdyn.F90 in trunk/NEMO/LIM_SRC – NEMO

source: trunk/NEMO/LIM_SRC/limdyn.F90 @ 303

Last change on this file since 303 was 288, checked in by opalod, 19 years ago

nemo_v1_bugfix_005 : CT : remove few bugs in the Sea-ice component related to the reproductibility problem of mono .vs. multi processors simulations

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.9 KB
Line 
1MODULE limdyn
2   !!======================================================================
3   !!                     ***  MODULE  limdyn  ***
4   !!   Sea-Ice dynamics : 
5   !!======================================================================
6#if defined key_ice_lim
7   !!----------------------------------------------------------------------
8   !!   'key_ice_lim' :                                   LIM sea-ice model
9   !!----------------------------------------------------------------------
10   !!    lim_dyn      : computes ice velocities
11   !!    lim_dyn_init : initialization and namelist read
12   !!----------------------------------------------------------------------
13   !! * Modules used
14   USE phycst
15   USE in_out_manager  ! I/O manager
16   USE dom_ice
17   USE dom_oce         ! ocean space and time domain
18   USE ice
19   USE ice_oce
20   USE iceini
21   USE limistate
22   USE limrhg          ! ice rheology
23   USE lbclnk
24   USE lib_mpp
25   USE prtctl          ! Print control
26
27   IMPLICIT NONE
28   PRIVATE
29
30   !! * Accessibility
31   PUBLIC lim_dyn  ! routine called by ice_step
32
33   !! * Module variables
34   REAL(wp)  ::  rone    = 1.e0   ! constant value
35
36   !!----------------------------------------------------------------------
37   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)
38   !! $Header$
39   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
40   !!----------------------------------------------------------------------
41
42CONTAINS
43
44   SUBROUTINE lim_dyn
45      !!-------------------------------------------------------------------
46      !!               ***  ROUTINE lim_dyn  ***
47      !!               
48      !! ** Purpose :   compute ice velocity and ocean-ice stress
49      !!               
50      !! ** Method  :
51      !!
52      !! ** Action  : - Initialisation
53      !!              - Call of the dynamic routine for each hemisphere
54      !!              - computation of the stress at the ocean surface         
55      !!              - treatment of the case if no ice dynamic
56      !! History :
57      !!   1.0  !  01-04  (LIM)  Original code
58      !!   2.0  !  02-08  (C. Ethe, G. Madec)  F90, mpp
59      !!---------------------------------------------------------------------
60      !! * Loal variables
61      INTEGER ::   ji, jj             ! dummy loop indices
62      INTEGER ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology
63      REAL(wp) ::   &
64         ztairx, ztairy,           &  ! tempory scalars
65         zsang , zmod,             &
66         ztglx , ztgly ,           &
67         zt11, zt12, zt21, zt22 ,  &
68         zustm, zsfrld, zsfrldm4,  &
69         zu_ice, zv_ice, ztair2
70      REAL(wp),DIMENSION(jpj) ::   &
71         zind,                     &  ! i-averaged indicator of sea-ice
72         zmsk                         ! i-averaged of tmask
73      !!---------------------------------------------------------------------
74
75      IF( numit == nstart  )   CALL lim_dyn_init   ! Initialization (first time-step only)
76     
77      IF ( ln_limdyn ) THEN
78
79         ! Mean ice and snow thicknesses.         
80         hsnm(:,:)  = ( 1.0 - frld(:,:) ) * hsnif(:,:)
81         hicm(:,:)  = ( 1.0 - frld(:,:) ) * hicif(:,:)
82
83         u_oce(:,:)  = u_io(:,:) * tmu(:,:)
84         v_oce(:,:)  = v_io(:,:) * tmu(:,:)
85       
86         !                                         ! Rheology (ice dynamics)
87         !                                         ! ========
88         
89         !  Define the j-limits where ice rheology is computed
90         ! ---------------------------------------------------
91         
92         IF( lk_mpp ) THEN                    ! mpp: compute over the whole domain
93            i_j1 = 1   
94            i_jpj = jpj
95            IF(ln_ctl)    THEN
96               CALL prt_ctl_info('lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj)
97            ENDIF
98            CALL lim_rhg( i_j1, i_jpj )
99
100         ELSE                                 ! optimization of the computational area
101
102            DO jj = 1, jpj
103               zind(jj) = SUM( frld (:,jj  ) )   ! = FLOAT(jpj) if ocean everywhere on a j-line
104               zmsk(jj) = SUM( tmask(:,jj,1) )   ! = 0          if land  everywhere on a j-line
105   !!i         write(numout,*) narea, 'limdyn' , jj, zind(jj), zmsk(jj)
106            END DO
107
108            IF( l_jeq ) THEN                     ! local domain include both hemisphere
109               !                                 ! Rheology is computed in each hemisphere
110               !                                 ! only over the ice cover latitude strip
111               ! Northern hemisphere
112               i_j1  = njeq
113               i_jpj = jpj
114               DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
115                  i_j1 = i_j1 + 1
116               END DO
117               i_j1 = MAX( 1, i_j1-1 )
118               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
119   
120               CALL lim_rhg( i_j1, i_jpj )
121   
122               ! Southern hemisphere
123               i_j1  =  1 
124               i_jpj = njeq
125               DO WHILE ( i_jpj >= 1 .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
126                  i_jpj = i_jpj - 1
127               END DO
128               i_jpj = MIN( jpj, i_jpj+2 )
129               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
130   
131               CALL lim_rhg( i_j1, i_jpj )
132   
133            ELSE                                 ! local domain extends over one hemisphere only
134               !                                 ! Rheology is computed only over the ice cover
135               !                                 ! latitude strip
136               i_j1  = 1
137               DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
138                  i_j1 = i_j1 + 1
139               END DO
140               i_j1 = MAX( 1, i_j1-1 )
141   
142               i_jpj  = jpj
143               DO WHILE ( i_jpj >= 1  .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
144                  i_jpj = i_jpj - 1
145               END DO
146               i_jpj = MIN( jpj, i_jpj+2)
147   
148               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
149   
150               CALL lim_rhg( i_j1, i_jpj )
151
152            ENDIF
153
154         ENDIF
155
156         IF(ln_ctl)   THEN
157            CALL prt_ctl(tab2d_1=u_oce , clinfo1=' lim_dyn  : u_oce :', tab2d_2=v_oce , clinfo2=' v_oce :')
158            CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_dyn  : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :')
159         ENDIF
160         
161         !                                         ! Ice-Ocean stress
162         !                                         ! ================
163         DO jj = 2, jpjm1
164            zsang  = SIGN(1.e0, gphif(1,jj-1) ) * sangvg
165            DO ji = 2, jpim1
166               ! computation of wind stress over ocean in X and Y direction
167#if defined key_coupled && defined key_lim_cp1
168               ztairx =  frld(ji-1,jj  ) * gtaux(ji-1,jj  ) + frld(ji,jj  ) * gtaux(ji,jj  )      &
169                  &    + frld(ji-1,jj-1) * gtaux(ji-1,jj-1) + frld(ji,jj-1) * gtaux(ji,jj-1)
170
171               ztairy =  frld(ji-1,jj  ) * gtauy(ji-1,jj  ) + frld(ji,jj  ) * gtauy(ji,jj  )      &
172                  &    + frld(ji-1,jj-1) * gtauy(ji-1,jj-1) + frld(ji,jj-1) * gtauy(ji,jj-1)
173#else
174               zsfrld  = frld(ji,jj) + frld(ji-1,jj) + frld(ji-1,jj-1) + frld(ji,jj-1)
175               ztairx  = zsfrld * gtaux(ji,jj)
176               ztairy  = zsfrld * gtauy(ji,jj)
177#endif
178               zsfrldm4 = 4 - frld(ji,jj) - frld(ji-1,jj) - frld(ji-1,jj-1) - frld(ji,jj-1)
179               zu_ice   = u_ice(ji,jj) - u_oce(ji,jj)
180               zv_ice   = v_ice(ji,jj) - v_oce(ji,jj)
181               zmod     = SQRT( zu_ice * zu_ice + zv_ice * zv_ice ) 
182               ztglx   = zsfrldm4 * rhoco * zmod * ( cangvg * zu_ice - zsang * zv_ice ) 
183               ztgly   = zsfrldm4 * rhoco * zmod * ( cangvg * zv_ice + zsang * zu_ice ) 
184
185               tio_u(ji,jj) = - ( ztairx + 1.0 * ztglx ) / ( 4 * rau0 )
186               tio_v(ji,jj) = - ( ztairy + 1.0 * ztgly ) / ( 4 * rau0 )
187            END DO
188         END DO
189         
190         ! computation of friction velocity
191         DO jj = 2, jpjm1
192            DO ji = 2, jpim1
193
194               zu_ice   = u_ice(ji-1,jj-1) - u_oce(ji-1,jj-1)
195               zv_ice   = v_ice(ji-1,jj-1) - v_oce(ji-1,jj-1)
196               zt11  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice )
197
198               zu_ice   = u_ice(ji-1,jj) - u_oce(ji-1,jj)
199               zv_ice   = v_ice(ji-1,jj) - v_oce(ji-1,jj)
200               zt12  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice ) 
201
202               zu_ice   = u_ice(ji,jj-1) - u_oce(ji,jj-1)
203               zv_ice   = v_ice(ji,jj-1) - v_oce(ji,jj-1)
204               zt21  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice ) 
205
206               zu_ice   = u_ice(ji,jj) - u_oce(ji,jj)
207               zv_ice   = v_ice(ji,jj) - v_oce(ji,jj)
208               zt22  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice ) 
209
210               ztair2 = gtaux(ji,jj) * gtaux(ji,jj) + gtauy(ji,jj) * gtauy(ji,jj)
211
212               zustm =  ( 1 - frld(ji,jj) ) * 0.25 * ( zt11 + zt12 + zt21 + zt22 )        &
213                  &  +        frld(ji,jj)   * SQRT( ztair2 )
214
215               ust2s(ji,jj) = ( zustm / rau0 ) * ( rone + sdvt(ji,jj) ) * tms(ji,jj)
216            END DO
217         END DO
218
219       ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean
220                   
221          DO jj = 2, jpjm1
222             DO ji = 2, jpim1
223#if defined key_coupled && defined key_lim_cp1
224                tio_u(ji,jj) = - (  gtaux(ji  ,jj  ) + gtaux(ji-1,jj  )       &
225                   &              + gtaux(ji-1,jj-1) + gtaux(ji  ,jj-1) ) / ( 4 * rau0 )
226
227                tio_v(ji,jj) = - (  gtauy(ji  ,jj )  + gtauy(ji-1,jj  )       &
228                   &              + gtauy(ji-1,jj-1) + gtauy(ji  ,jj-1) ) / ( 4 * rau0 )
229#else
230                tio_u(ji,jj) = - gtaux(ji,jj) / rau0
231                tio_v(ji,jj) = - gtauy(ji,jj) / rau0 
232#endif
233                ztair2       = gtaux(ji,jj) * gtaux(ji,jj) + gtauy(ji,jj) * gtauy(ji,jj)
234                zustm        = SQRT( ztair2  )
235
236                ust2s(ji,jj) = ( zustm / rau0 ) * ( rone + sdvt(ji,jj) ) * tms(ji,jj)
237            END DO
238         END DO
239
240      ENDIF
241
242      CALL lbc_lnk( ust2s, 'T',  1. )   ! T-point
243      CALL lbc_lnk( tio_u, 'I', -1. )   ! I-point (i.e. ice U-V point)
244      CALL lbc_lnk( tio_v, 'I', -1. )   ! I-point (i.e. ice U-V point)
245
246      IF(ln_ctl) THEN
247            CALL prt_ctl(tab2d_1=tio_u , clinfo1=' lim_dyn  : tio_u :', tab2d_2=tio_v , clinfo2=' tio_v :')
248            CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :')
249      ENDIF
250
251   END SUBROUTINE lim_dyn
252
253
254   SUBROUTINE lim_dyn_init
255      !!-------------------------------------------------------------------
256      !!                  ***  ROUTINE lim_dyn_init  ***
257      !!
258      !! ** Purpose : Physical constants and parameters linked to the ice
259      !!      dynamics
260      !!
261      !! ** Method  :  Read the namicedyn namelist and check the ice-dynamic
262      !!       parameter values called at the first timestep (nit000)
263      !!
264      !! ** input   :   Namelist namicedyn
265      !!
266      !! history :
267      !!  8.5  ! 03-08 (C. Ethe) original code
268      !!-------------------------------------------------------------------
269      NAMELIST/namicedyn/ epsd, alpha,     &
270         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   &
271         &                c_rhg, etamn, creepl, ecc, ahi0
272      !!-------------------------------------------------------------------
273
274      ! Define the initial parameters
275      ! -------------------------
276
277      ! Read Namelist namicedyn
278      REWIND ( numnam_ice )
279      READ   ( numnam_ice  , namicedyn )
280      IF(lwp) THEN
281         WRITE(numout,*)
282         WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics '
283         WRITE(numout,*) '~~~~~~~~~~~~'
284         WRITE(numout,*) '       tolerance parameter                              epsd   = ', epsd
285         WRITE(numout,*) '       coefficient for semi-implicit coriolis           alpha  = ', alpha
286         WRITE(numout,*) '       diffusion constant for dynamics                  dm     = ', dm
287         WRITE(numout,*) '       number of sub-time steps for relaxation          nbiter = ', nbiter
288         WRITE(numout,*) '       maximum number of iterations for relaxation      nbitdr = ', nbitdr
289         WRITE(numout,*) '       relaxation constant                              om     = ', om
290         WRITE(numout,*) '       maximum value for the residual of relaxation     resl   = ', resl
291         WRITE(numout,*) '       drag coefficient for oceanic stress              cw     = ', cw
292         WRITE(numout,*) '       turning angle for oceanic stress                 angvg  = ', angvg
293         WRITE(numout,*) '       first bulk-rheology parameter                    pstar  = ', pstar
294         WRITE(numout,*) '       second bulk-rhelogy parameter                    c_rhg  = ', c_rhg
295         WRITE(numout,*) '       minimun value for viscosity                      etamn  = ', etamn
296         WRITE(numout,*) '       creep limit                                      creepl = ', creepl
297         WRITE(numout,*) '       eccentricity of the elliptical yield curve       ecc    = ', ecc
298         WRITE(numout,*) '       horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0
299      ENDIF
300
301      usecc2 = 1.0 / ( ecc * ecc )
302      rhoco  = rau0 * cw
303      angvg  = angvg * rad
304      sangvg = SIN( angvg )
305      cangvg = COS( angvg )
306      pstarh = pstar / 2.0
307
308      !  Diffusion coefficients.
309      ahiu(:,:) = ahi0 * umask(:,:,1)
310      ahiv(:,:) = ahi0 * vmask(:,:,1)
311
312   END SUBROUTINE lim_dyn_init
313
314#else
315   !!----------------------------------------------------------------------
316   !!   Default option          Empty module           NO LIM sea-ice model
317   !!----------------------------------------------------------------------
318CONTAINS
319   SUBROUTINE lim_dyn         ! Empty routine
320   END SUBROUTINE lim_dyn
321#endif 
322
323   !!======================================================================
324END MODULE limdyn
Note: See TracBrowser for help on using the repository browser.