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 @ 247

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

CL : Add CVS Header and CeCILL licence information

  • 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
26   IMPLICIT NONE
27   PRIVATE
28
29   !! * Accessibility
30   PUBLIC lim_dyn  ! routine called by ice_step
31
32   !! * Module variables
33   REAL(wp)  ::  rone    = 1.e0   ! constant value
34
35   !!----------------------------------------------------------------------
36   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)
37   !! $Header$
38   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
39   !!----------------------------------------------------------------------
40
41CONTAINS
42
43   SUBROUTINE lim_dyn
44      !!-------------------------------------------------------------------
45      !!               ***  ROUTINE lim_dyn  ***
46      !!               
47      !! ** Purpose :   compute ice velocity and ocean-ice stress
48      !!               
49      !! ** Method  :
50      !!
51      !! ** Action  : - Initialisation
52      !!              - Call of the dynamic routine for each hemisphere
53      !!              - computation of the stress at the ocean surface         
54      !!              - treatment of the case if no ice dynamic
55      !! History :
56      !!   1.0  !  01-04  (LIM)  Original code
57      !!   2.0  !  02-08  (C. Ethe, G. Madec)  F90, mpp
58      !!---------------------------------------------------------------------
59      !! * Loal variables
60      INTEGER ::   ji, jj             ! dummy loop indices
61      INTEGER ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology
62      REAL(wp) ::   &
63         ztairx, ztairy,           &  ! tempory scalars
64         zsang , zmod,             &
65         ztglx , ztgly ,           &
66         zt11, zt12, zt21, zt22 ,  &
67         zustm, zsfrld, zsfrldm4,  &
68         zu_ice, zv_ice, ztair2
69      REAL(wp),DIMENSION(jpj) ::   &
70         zind,                     &  ! i-averaged indicator of sea-ice
71         zmsk                         ! i-averaged of tmask
72      !!---------------------------------------------------------------------
73
74      IF( numit == nstart  )   CALL lim_dyn_init   ! Initialization (first time-step only)
75     
76      IF ( ln_limdyn ) THEN
77
78         ! Mean ice and snow thicknesses.         
79         hsnm(:,:)  = ( 1.0 - frld(:,:) ) * hsnif(:,:)
80         hicm(:,:)  = ( 1.0 - frld(:,:) ) * hicif(:,:)
81
82         u_oce(:,:)  = u_io(:,:) * tmu(:,:)
83         v_oce(:,:)  = v_io(:,:) * tmu(:,:)
84       
85         !                                         ! Rheology (ice dynamics)
86         !                                         ! ========
87         
88         !  Define the j-limits where ice rheology is computed
89         ! ---------------------------------------------------
90         
91         IF( lk_mpp ) THEN                    ! mpp: compute over the whole domain
92            i_j1 = 1   
93            i_jpj = jpj
94            IF(l_ctl)   WRITE(numout,*) 'lim_dyn :    i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
95            CALL lim_rhg( i_j1, i_jpj )
96
97         ELSE                                 ! optimization of the computational area
98
99            DO jj = 1, jpj
100               zind(jj) = SUM( frld (:,jj  ) )   ! = FLOAT(jpj) if ocean everywhere on a j-line
101               zmsk(jj) = SUM( tmask(:,jj,1) )   ! = 0          if land  everywhere on a j-line
102   !!i         write(numout,*) narea, 'limdyn' , jj, zind(jj), zmsk(jj)
103            END DO
104
105            IF( l_jeq ) THEN                     ! local domain include both hemisphere
106               !                                 ! Rheology is computed in each hemisphere
107               !                                 ! only over the ice cover latitude strip
108               ! Northern hemisphere
109               i_j1  = njeq
110               i_jpj = jpj
111               DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
112                  i_j1 = i_j1 + 1
113               END DO
114               i_j1 = MAX( 1, i_j1-1 )
115               IF(l_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
116   
117               CALL lim_rhg( i_j1, i_jpj )
118   
119               ! Southern hemisphere
120               i_j1  =  1 
121               i_jpj = njeq
122               DO WHILE ( i_jpj >= 1 .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
123                  i_jpj = i_jpj - 1
124               END DO
125               i_jpj = MIN( jpj, i_jpj+2 )
126               IF(l_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
127   
128               CALL lim_rhg( i_j1, i_jpj )
129   
130            ELSE                                 ! local domain extends over one hemisphere only
131               !                                 ! Rheology is computed only over the ice cover
132               !                                 ! latitude strip
133               i_j1  = 1
134               DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
135                  i_j1 = i_j1 + 1
136               END DO
137               i_j1 = MAX( 1, i_j1-1 )
138   
139               i_jpj  = jpj
140               DO WHILE ( i_jpj >= 1  .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
141                  i_jpj = i_jpj - 1
142               END DO
143               i_jpj = MIN( jpj, i_jpj+2)
144   
145               IF(l_ctl)   WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
146   
147               CALL lim_rhg( i_j1, i_jpj )
148
149            ENDIF
150
151         ENDIF
152
153         u_ice(:,1) = 0.e0       !ibug  est-ce vraiment necessaire?
154         v_ice(:,1) = 0.e0
155
156         IF(l_ctl) THEN
157            WRITE(numout,*) ' lim_dyn  : u_oce ', SUM( u_oce(2:nictl,2:njctl) ), ' v_oce ', SUM( v_oce(2:nictl,2:njctl) )
158            WRITE(numout,*) ' lim_dyn  : u_ice ', SUM( u_ice(2:nictl,2:njctl) ), ' v_ice ', SUM( v_ice(2:nictl,2:njctl) )
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(l_ctl) THEN
247         WRITE(numout,*) ' lim_dyn  : tio_u ', SUM( tio_u(2:nictl,2:njctl) ), ' tio_v ', SUM( tio_v(2:nictl,2:njctl) )
248         WRITE(numout,*) ' lim_dyn  : ust2s ', SUM( ust2s(2:nictl,2:njctl) )
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.