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

Last change on this file since 716 was 716, checked in by smasson, 17 years ago

continue changeset:700, see ticket:2

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 12.1 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#  include "vectopt_loop_substitute.h90"
38
39   !!----------------------------------------------------------------------
40   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)
41   !! $Id$
42   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
43   !!----------------------------------------------------------------------
44
45CONTAINS
46
47   SUBROUTINE lim_dyn( kt )
48      !!-------------------------------------------------------------------
49      !!               ***  ROUTINE lim_dyn  ***
50      !!               
51      !! ** Purpose :   compute ice velocity and ocean-ice stress
52      !!               
53      !! ** Method  :
54      !!
55      !! ** Action  : - Initialisation
56      !!              - Call of the dynamic routine for each hemisphere
57      !!              - computation of the stress at the ocean surface         
58      !!              - treatment of the case if no ice dynamic
59      !! History :
60      !!   1.0  !  01-04  (LIM)  Original code
61      !!   2.0  !  02-08  (C. Ethe, G. Madec)  F90, mpp
62      !!---------------------------------------------------------------------
63      INTEGER, INTENT(in) ::   kt     ! number of iteration
64
65      INTEGER ::   ji, jj             ! dummy loop indices
66      INTEGER ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology
67      REAL(wp) ::   &
68         ztairx, ztairy,           &  ! tempory scalars
69         zsang , zrhomod,             &
70         ztglx , ztgly ,           &
71         zt11, zt12, zt21, zt22 ,  &
72         zustm, zsfrld, zsfrldm4,  &
73         zu_ice, zv_ice, ztair2
74      REAL(wp),DIMENSION(jpi,jpj) ::   zmod
75      REAL(wp),DIMENSION(jpj) ::   &
76         zind,                     &  ! i-averaged indicator of sea-ice
77         zmsk                         ! i-averaged of tmask
78      !!---------------------------------------------------------------------
79
80      IF( kt == nit000  )   CALL lim_dyn_init   ! Initialization (first time-step only)
81     
82      IF ( ln_limdyn ) THEN
83
84         ! Mean ice and snow thicknesses.         
85         hsnm(:,:)  = ( 1.0 - frld(:,:) ) * hsnif(:,:)
86         hicm(:,:)  = ( 1.0 - frld(:,:) ) * hicif(:,:)
87
88         u_io(:,:)  = u_io(:,:) * tmu(:,:)
89         v_io(:,:)  = v_io(:,:) * tmu(:,:)
90       
91         !                                         ! Rheology (ice dynamics)
92         !                                         ! ========
93         
94         !  Define the j-limits where ice rheology is computed
95         ! ---------------------------------------------------
96         
97         IF( lk_mpp .OR. nbit_cmp == 1 ) THEN                    ! mpp: compute over the whole domain
98            i_j1 = 1   
99            i_jpj = jpj
100            IF(ln_ctl)    THEN
101               CALL prt_ctl_info('lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj)
102            ENDIF
103            CALL lim_rhg( i_j1, i_jpj )
104
105         ELSE                                 ! optimization of the computational area
106
107            DO jj = 1, jpj
108               zind(jj) = SUM( frld (:,jj  ) )   ! = FLOAT(jpj) if ocean everywhere on a j-line
109               zmsk(jj) = SUM( tmask(:,jj,1) )   ! = 0          if land  everywhere on a j-line
110   !!i         write(numout,*) narea, 'limdyn' , jj, zind(jj), zmsk(jj)
111            END DO
112
113            IF( l_jeq ) THEN                     ! local domain include both hemisphere
114               !                                 ! Rheology is computed in each hemisphere
115               !                                 ! only over the ice cover latitude strip
116               ! Northern hemisphere
117               i_j1  = njeq
118               i_jpj = jpj
119               DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
120                  i_j1 = i_j1 + 1
121               END DO
122               i_j1 = MAX( 1, i_j1-1 )
123               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
124   
125               CALL lim_rhg( i_j1, i_jpj )
126   
127               ! Southern hemisphere
128               i_j1  =  1 
129               i_jpj = njeq
130               DO WHILE ( i_jpj >= 1 .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
131                  i_jpj = i_jpj - 1
132               END DO
133               i_jpj = MIN( jpj, i_jpj+2 )
134               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
135   
136               CALL lim_rhg( i_j1, i_jpj )
137   
138            ELSE                                 ! local domain extends over one hemisphere only
139               !                                 ! Rheology is computed only over the ice cover
140               !                                 ! latitude strip
141               i_j1  = 1
142               DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 )
143                  i_j1 = i_j1 + 1
144               END DO
145               i_j1 = MAX( 1, i_j1-1 )
146   
147               i_jpj  = jpj
148               DO WHILE ( i_jpj >= 1  .AND. zind(i_jpj) == FLOAT(jpi) .AND. zmsk(i_jpj) /=0 )
149                  i_jpj = i_jpj - 1
150               END DO
151               i_jpj = MIN( jpj, i_jpj+2)
152   
153               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
154   
155               CALL lim_rhg( i_j1, i_jpj )
156
157            ENDIF
158
159         ENDIF
160
161         IF(ln_ctl)   THEN
162            CALL prt_ctl(tab2d_1=u_io , clinfo1=' lim_dyn  : u_io :', tab2d_2=v_io , clinfo2=' v_io :')
163            CALL prt_ctl(tab2d_1=u_ice, clinfo1=' lim_dyn  : u_ice:', tab2d_2=v_ice, clinfo2=' v_ice:')
164         ENDIF
165         
166         !                                         ! Ice-Ocean stress
167         !                                         ! ================       
168         DO jj = 1, jpj
169            DO ji = 1, jpi
170!!              zsang  = SIGN(1.e0, gphif(ji-1,jj-1) ) * sangvg    ! do the full loop and avoid lbc_lnk
171               zsang  = SIGN(1.e0, gphif(ji,jj) ) * sangvg
172               zu_ice   = u_ice(ji,jj) - u_io(ji,jj)
173               zv_ice   = v_ice(ji,jj) - v_io(ji,jj)
174               zrhomod  = zu_ice * zu_ice + zv_ice * zv_ice 
175               zmod (ji,jj) = zrhomod 
176               zrhomod  = rhoco * SQRT( zrhomod ) 
177               ftaux(ji,jj) = zrhomod * ( cangvg * zu_ice - zsang * zv_ice ) 
178               ftauy(ji,jj) = zrhomod * ( cangvg * zv_ice + zsang * zu_ice ) 
179            END DO
180         END DO
181
182         ! computation of friction velocity
183         DO jj = 2, jpjm1
184            DO ji = fs_2, fs_jpim1     ! vector opt.
185               ust2s(ji,jj) = 0.25 * cw * ( zmod(ji,jj+1) + zmod(ji+1,jj+1) +    &
186                  &                         zmod(ji,jj  ) + zmod(ji+1,jj  ) ) * tms(ji,jj)
187            END DO
188         END DO
189
190       ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean
191                   
192          ftaux(:,:) = gtaux(:,:) 
193          ftauy(:,:) = gtauy(:,:) 
194
195          DO jj = 2, jpjm1
196             DO ji = 2, jpim1
197                ztair2 = gtaux(ji  ,jj+1) * gtaux(ji  ,jj+1) + gtauy(ji  ,jj+1) * gtauy(ji  ,jj+1)   &
198                &      + gtaux(ji+1,jj+1) * gtaux(ji+1,jj+1) + gtauy(ji+1,jj+1) * gtauy(ji+1,jj+1)   &
199                &      + gtaux(ji  ,jj  ) * gtaux(ji  ,jj  ) + gtauy(ji  ,jj  ) * gtauy(ji  ,jj  )   &
200                &      + gtaux(ji+1,jj  ) * gtaux(ji+1,jj  ) + gtauy(ji+1,jj  ) * gtauy(ji+1,jj  ) 
201
202                ust2s(ji,jj) = 0.25 / rau0 * SQRT( ztair2 ) * tms(ji,jj)
203            END DO
204         END DO
205
206      ENDIF
207
208      CALL lbc_lnk( ust2s, 'T',  1. )   ! T-point
209
210      IF(ln_ctl) THEN
211            CALL prt_ctl(tab2d_1=ftaux , clinfo1=' lim_dyn  : ftaux :', tab2d_2=ftauy , clinfo2=' ftauy :')
212            CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :')
213      ENDIF
214
215   END SUBROUTINE lim_dyn
216
217
218   SUBROUTINE lim_dyn_init
219      !!-------------------------------------------------------------------
220      !!                  ***  ROUTINE lim_dyn_init  ***
221      !!
222      !! ** Purpose : Physical constants and parameters linked to the ice
223      !!      dynamics
224      !!
225      !! ** Method  :  Read the namicedyn namelist and check the ice-dynamic
226      !!       parameter values called at the first timestep (nit000)
227      !!
228      !! ** input   :   Namelist namicedyn
229      !!
230      !! history :
231      !!  8.5  ! 03-08 (C. Ethe) original code
232      !!-------------------------------------------------------------------
233      NAMELIST/namicedyn/ epsd, alpha,     &
234         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   &
235         &                c_rhg, etamn, creepl, ecc, ahi0
236      !!-------------------------------------------------------------------
237
238      ! Define the initial parameters
239      ! -------------------------
240
241      ! Read Namelist namicedyn
242      REWIND ( numnam_ice )
243      READ   ( numnam_ice  , namicedyn )
244      IF(lwp) THEN
245         WRITE(numout,*)
246         WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics '
247         WRITE(numout,*) '~~~~~~~~~~~~'
248         WRITE(numout,*) '       tolerance parameter                              epsd   = ', epsd
249         WRITE(numout,*) '       coefficient for semi-implicit coriolis           alpha  = ', alpha
250         WRITE(numout,*) '       diffusion constant for dynamics                  dm     = ', dm
251         WRITE(numout,*) '       number of sub-time steps for relaxation          nbiter = ', nbiter
252         WRITE(numout,*) '       maximum number of iterations for relaxation      nbitdr = ', nbitdr
253         WRITE(numout,*) '       relaxation constant                              om     = ', om
254         WRITE(numout,*) '       maximum value for the residual of relaxation     resl   = ', resl
255         WRITE(numout,*) '       drag coefficient for oceanic stress              cw     = ', cw
256         WRITE(numout,*) '       turning angle for oceanic stress                 angvg  = ', angvg
257         WRITE(numout,*) '       first bulk-rheology parameter                    pstar  = ', pstar
258         WRITE(numout,*) '       second bulk-rhelogy parameter                    c_rhg  = ', c_rhg
259         WRITE(numout,*) '       minimun value for viscosity                      etamn  = ', etamn
260         WRITE(numout,*) '       creep limit                                      creepl = ', creepl
261         WRITE(numout,*) '       eccentricity of the elliptical yield curve       ecc    = ', ecc
262         WRITE(numout,*) '       horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0
263      ENDIF
264
265      !  Initialization
266      usecc2 = 1.0 / ( ecc * ecc )
267      rhoco  = rau0 * cw
268      angvg  = angvg * rad
269      sangvg = SIN( angvg )
270      cangvg = COS( angvg )
271      pstarh = pstar / 2.0
272      sdvt(:,:) = 0.e0
273
274      !  Diffusion coefficients.
275      ahiu(:,:) = ahi0 * umask(:,:,1)
276      ahiv(:,:) = ahi0 * vmask(:,:,1)
277
278   END SUBROUTINE lim_dyn_init
279
280#else
281   !!----------------------------------------------------------------------
282   !!   Default option          Empty module           NO LIM sea-ice model
283   !!----------------------------------------------------------------------
284CONTAINS
285   SUBROUTINE lim_dyn         ! Empty routine
286   END SUBROUTINE lim_dyn
287#endif 
288
289   !!======================================================================
290END MODULE limdyn
Note: See TracBrowser for help on using the repository browser.