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.
agrif_ice_interp.F90 in NEMO/trunk/src/NST – NEMO

source: NEMO/trunk/src/NST/agrif_ice_interp.F90 @ 14117

Last change on this file since 14117 was 14086, checked in by cetlod, 4 years ago

Adding AGRIF branches into the trunk
  • Property svn:keywords set to Id
File size: 20.3 KB
Line 
1MODULE agrif_ice_interp
2   !!=====================================================================================
3   !!                       ***  MODULE agrif_ice_interp ***
4   !! Nesting module :  interp surface ice boundary condition from a parent grid
5   !!=====================================================================================
6   !! History :  2.0   !  04-2008  (F. Dupont)               initial version
7   !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP
8   !!            4.0   !  2018     (C. Rousset)              SI3 compatibility
9   !!----------------------------------------------------------------------
10#if defined key_agrif && defined key_si3 
11   !!----------------------------------------------------------------------
12   !!   'key_si3'                                         SI3 sea-ice model
13   !!   'key_agrif'                                       AGRIF library
14   !!----------------------------------------------------------------------
15   !!  agrif_interp_ice    : interpolation of ice at "after" sea-ice time step
16   !!  interp_u_ice   : atomic routine to interpolate u_ice
17   !!  interp_v_ice   : atomic routine to interpolate v_ice
18   !!  interp_tra_ice : atomic routine to interpolate ice properties
19   !!----------------------------------------------------------------------
20   USE par_oce
21   USE dom_oce
22   USE sbc_oce
23   USE ice
24   USE agrif_ice
25   USE agrif_oce
26   USE phycst , ONLY: rt0
27   USE icevar
28   USE sbc_ice, ONLY : tn_ice
29   
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   agrif_interp_ice   ! called by agrif_user.F90
34   PUBLIC   agrif_istate_ice   ! called by icerst.F90
35
36   !!----------------------------------------------------------------------
37   !! NEMO/NST 4.0 , NEMO Consortium (2018)
38   !! $Id$
39   !! Software governed by the CeCILL license (see ./LICENSE)
40   !!----------------------------------------------------------------------
41
42CONTAINS
43
44   SUBROUTINE agrif_istate_ice
45      !!-----------------------------------------------------------------------
46      !!                 *** ROUTINE agrif_istate_ice  ***
47      !!
48      !!  ** Method  : Set initial ice fields from parent grid
49      !!
50      !!-----------------------------------------------------------------------
51      IF(lwp) WRITE(numout,*) ' '
52      IF(lwp) WRITE(numout,*) 'Agrif_istate_ice : interp child ice initial state from parent'
53      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
54      IF(lwp) WRITE(numout,*) ' '
55
56      ! Set a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i:
57      Agrif_SpecialValue    = -9999.
58      Agrif_UseSpecialValue = .TRUE.
59      CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice)
60      !
61      ! Set u_ice, v_ice:
62      use_sign_north = .TRUE.
63      sign_north = -1.
64      Agrif_UseSpecialValue = .TRUE.
65      CALL Agrif_init_variable(u_iceini_id  ,procname=interp_u_ice)
66      CALL Agrif_init_variable(v_iceini_id  ,procname=interp_v_ice)
67      Agrif_SpecialValue = 0._wp
68      use_sign_north = .FALSE.
69      Agrif_UseSpecialValue = .FALSE.
70      ! lbc ????
71      ! JC: do we really need the 3 lines below ?
72      CALL ice_var_glo2eqv
73      CALL ice_var_zapsmall
74      CALL ice_var_agg(2)
75
76      ! Melt ponds
77      WHERE( a_i > epsi10 )
78         a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:)
79      ELSEWHERE
80         a_ip_frac(:,:,:) = 0._wp
81      END WHERE
82      WHERE( a_ip > 0._wp )       ! ???????   
83         h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:)
84      ELSEWHERE
85         h_ip(:,:,:) = 0._wp
86      END WHERE   
87
88      tn_ice(:,:,:) = t_su(:,:,:)
89      t1_ice(:,:,:) = t_i (:,:,1,:) 
90
91   END SUBROUTINE agrif_istate_ice
92
93   SUBROUTINE agrif_interp_ice( cd_type, kiter, kitermax )
94      !!-----------------------------------------------------------------------
95      !!                 *** ROUTINE agrif_interp_ice  ***
96      !!
97      !!  ** Method  : simple call to atomic routines using stored values to
98      !!  fill the boundaries depending of the position of the point and
99      !!  computing factor for time interpolation
100      !!-----------------------------------------------------------------------
101      CHARACTER(len=1), INTENT(in   )           ::   cd_type
102      INTEGER         , INTENT(in   ), OPTIONAL ::   kiter, kitermax
103      !!
104      REAL(wp) ::   zbeta   ! local scalar
105      !!-----------------------------------------------------------------------
106      !
107      IF( Agrif_Root() .OR. nn_ice==0 )  RETURN   ! do not interpolate if inside Parent Grid or if child domain does not have ice
108      !
109      SELECT CASE( cd_type )
110      CASE('U','V')
111         IF( PRESENT( kiter ) ) THEN  ! interpolation at the child ice sub-time step (only for ice rheology)
112            zbeta = ( REAL(nbstep_ice) - REAL(kitermax - kiter) / REAL(kitermax) ) /  &
113               &    ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) )
114         ELSE                         ! interpolation at the child ice time step
115            zbeta = REAL(nbstep_ice) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) )
116         ENDIF
117      CASE('T')
118            zbeta = REAL(nbstep_ice) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) )
119      END SELECT
120      !
121      Agrif_SpecialValue    = -9999.
122      Agrif_UseSpecialValue = .TRUE.
123
124      use_sign_north = .TRUE.
125      sign_north = -1.
126      if (cd_type == 'T') use_sign_north = .FALSE.
127
128      SELECT CASE( cd_type )
129      CASE('U')   ;   CALL Agrif_Bc_variable( u_ice_id  , procname=interp_u_ice  , calledweight=zbeta )
130      CASE('V')   ;   CALL Agrif_Bc_variable( v_ice_id  , procname=interp_v_ice  , calledweight=zbeta )
131      CASE('T')   ;   CALL Agrif_Bc_variable( tra_ice_id, procname=interp_tra_ice, calledweight=zbeta )
132      END SELECT
133      Agrif_SpecialValue    = 0._wp
134      Agrif_UseSpecialValue = .FALSE.
135     
136      use_sign_north = .FALSE.
137      !
138   END SUBROUTINE agrif_interp_ice
139
140
141   SUBROUTINE interp_u_ice( ptab, i1, i2, j1, j2, before )
142      !!-----------------------------------------------------------------------
143      !!                     *** ROUTINE interp_u_ice ***
144      !!
145      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
146      !! To solve issues when parent grid is "land" masked but not all the corresponding child
147      !! grid points, put Agrif_SpecialValue WHERE the parent grid is masked.
148      !! The child solution will be found in the 9(?) points around
149      !!-----------------------------------------------------------------------
150      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
151      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
152      LOGICAL                         , INTENT(in   ) ::   before
153      !!
154      REAL(wp) ::   zrhoy   ! local scalar
155      !!-----------------------------------------------------------------------
156      !
157      IF( before ) THEN  ! parent grid
158         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2)
159         WHERE( umask(i1:i2,j1:j2,1) == 0. )   ptab(i1:i2,j1:j2) = Agrif_SpecialValue
160      ELSE               ! child grid
161         zrhoy = Agrif_Rhoy()
162         u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1)
163      ENDIF
164      !
165   END SUBROUTINE interp_u_ice
166
167
168   SUBROUTINE interp_v_ice( ptab, i1, i2, j1, j2, before )
169      !!-----------------------------------------------------------------------
170      !!                    *** ROUTINE interp_v_ice ***
171      !!
172      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
173      !! To solve issues when parent grid is "land" masked but not all the corresponding child
174      !! grid points, put Agrif_SpecialValue WHERE the parent grid is masked.
175      !! The child solution will be found in the 9(?) points around
176      !!-----------------------------------------------------------------------     
177      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
178      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
179      LOGICAL                         , INTENT(in   ) ::   before
180      !!
181      REAL(wp) ::   zrhox   ! local scalar
182      !!-----------------------------------------------------------------------
183      !
184      IF( before ) THEN  ! parent grid
185         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2)
186         WHERE( vmask(i1:i2,j1:j2,1) == 0. )   ptab(i1:i2,j1:j2) = Agrif_SpecialValue
187      ELSE               ! child grid
188         zrhox = Agrif_Rhox()
189         v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1)
190      ENDIF
191      !
192   END SUBROUTINE interp_v_ice
193
194
195   SUBROUTINE interp_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
196      !!-----------------------------------------------------------------------
197      !!                    *** ROUTINE interp_tra_ice ***                           
198      !!
199      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
200      !! To solve issues when parent grid is "land" masked but not all the corresponding child
201      !! grid points, put Agrif_SpecialValue WHERE the parent grid is masked.
202      !! The child solution will be found in the 9(?) points around
203      !!-----------------------------------------------------------------------
204      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
205      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
206      LOGICAL                               , INTENT(in   ) ::   before
207      INTEGER                               , INTENT(in   ) ::   nb, ndir
208      !!
209      INTEGER  ::   ji, jj, jk, jl, jm
210      INTEGER  ::   imin, imax, jmin, jmax
211      LOGICAL  ::   western_side, eastern_side, northern_side, southern_side
212      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7
213      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztab
214      !!-----------------------------------------------------------------------
215      ! tracers are not multiplied by grid cell here => before: * e1e2t ; after: * r1_e1e2t / rhox / rhoy
216      ! and it is ok since we conserve tracers (same as in the ocean).
217      ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) )
218
219      IF( before ) THEN  ! parent grid
220         jm = 1
221         DO jl = 1, jpl
222            ptab(i1:i2,j1:j2,jm  ) = a_i (i1:i2,j1:j2,jl)
223            ptab(i1:i2,j1:j2,jm+1) = v_i (i1:i2,j1:j2,jl)
224            ptab(i1:i2,j1:j2,jm+2) = v_s (i1:i2,j1:j2,jl)
225            ptab(i1:i2,j1:j2,jm+3) = sv_i(i1:i2,j1:j2,jl)
226            ptab(i1:i2,j1:j2,jm+4) = oa_i(i1:i2,j1:j2,jl)
227            ptab(i1:i2,j1:j2,jm+5) = a_ip(i1:i2,j1:j2,jl)
228            ptab(i1:i2,j1:j2,jm+6) = v_ip(i1:i2,j1:j2,jl)
229            ptab(i1:i2,j1:j2,jm+7) = v_il(i1:i2,j1:j2,jl)
230            ptab(i1:i2,j1:j2,jm+8) = t_su(i1:i2,j1:j2,jl)
231            jm = jm + 9
232            DO jk = 1, nlay_s
233               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
234            END DO
235            DO jk = 1, nlay_i
236               ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
237            END DO
238         END DO
239         
240         DO jk = k1, k2
241            WHERE( tmask(i1:i2,j1:j2,1) == 0._wp )   ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValue
242         END DO
243         !
244      ELSE               ! child grid
245         !
246!         IF( nbghostcells > 1 ) THEN   ! ==> The easiest interpolation is used
247            !
248            jm = 1
249            DO jl = 1, jpl
250               !
251               DO jj = j1, j2
252                  DO ji = i1, i2
253                     a_i (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1)
254                     v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1)
255                     v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1)
256                     sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1)
257                     oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1)
258                     a_ip(ji,jj,jl) = ptab(ji,jj,jm+5) * tmask(ji,jj,1)
259                     v_ip(ji,jj,jl) = ptab(ji,jj,jm+6) * tmask(ji,jj,1)
260                     v_il(ji,jj,jl) = ptab(ji,jj,jm+7) * tmask(ji,jj,1)
261                     t_su(ji,jj,jl) = ptab(ji,jj,jm+8) * tmask(ji,jj,1)
262                  END DO
263               END DO
264               jm = jm + 9
265               !
266               DO jk = 1, nlay_s
267                  e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
268                  jm = jm + 1
269               END DO
270               !
271               DO jk = 1, nlay_i
272                  e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
273                  jm = jm + 1
274               END DO
275               !
276            END DO
277            !
278!!==> clem: this interpolation does not work because it creates negative values, due
279!!          to negative coefficients when mixing points (for ex. z7)
280!!
281!         ELSE                          ! ==> complex interpolation (only one ghost cell available)
282!            !! Use a more complex interpolation since we mix solutions over a couple of grid points
283!            !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...)
284!            ! record ztab
285!            jm = 1
286!            DO jl = 1, jpl
287!               ztab(:,:,jm  ) = a_i (:,:,jl)
288!               ztab(:,:,jm+1) = v_i (:,:,jl)
289!               ztab(:,:,jm+2) = v_s (:,:,jl)
290!               ztab(:,:,jm+3) = sv_i(:,:,jl)
291!               ztab(:,:,jm+4) = oa_i(:,:,jl)
292!               ztab(:,:,jm+5) = a_ip(:,:,jl)
293!               ztab(:,:,jm+6) = v_ip(:,:,jl)
294!               ztab(:,:,jm+7) = v_il(:,:,jl)
295!               ztab(:,:,jm+8) = t_su(:,:,jl)
296!               jm = jm + 9
297!               DO jk = 1, nlay_s
298!                  ztab(:,:,jm) = e_s(:,:,jk,jl)
299!                  jm = jm + 1
300!               END DO
301!               DO jk = 1, nlay_i
302!                  ztab(:,:,jm) = e_i(:,:,jk,jl)
303!                  jm = jm + 1
304!               END DO
305!               !
306!            END DO
307!            !
308!            ! borders of the domain
309!            western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2)
310!            southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2)
311!            !
312!            ! spatial smoothing
313!            zrhox = Agrif_Rhox()
314!            z1 =      ( zrhox - 1. ) * 0.5
315!            z3 =      ( zrhox - 1. ) / ( zrhox + 1. )
316!            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
317!            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
318!            z2 = 1. - z1
319!            z4 = 1. - z3
320!            z5 = 1. - z6 - z7
321!            !
322!            ! Remove corners
323!            imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2
324!            IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3
325!            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = jpj-2
326!            IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3
327!            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = jpi-2
328!
329!            ! smoothed fields
330!            IF( eastern_side ) THEN
331!               ztab(jpi,j1:j2,:) = z1 * ptab(jpi,j1:j2,:) + z2 * ptab(jpi-1,j1:j2,:)
332!               DO jj = jmin, jmax
333!                  rswitch = 0.
334!                  IF( u_ice(jpi-2,jj) > 0._wp ) rswitch = 1.
335!                  ztab(jpi-1,jj,:) = ( 1. - umask(jpi-2,jj,1) ) * ztab(jpi,jj,:)  &
336!                     &               +      umask(jpi-2,jj,1)   *  &
337!                     &               ( (1. - rswitch) * ( z4 * ztab(jpi  ,jj,:) + z3 * ztab(jpi-2,jj,:) )  &
338!                     &                 +     rswitch  * ( z6 * ztab(jpi-2,jj,:) + z5 * ztab(jpi  ,jj,:) + z7 * ztab(jpi-3,jj,:) ) )
339!                  ztab(jpi-1,jj,:) = ztab(jpi-1,jj,:) * tmask(jpi-1,jj,1)
340!               END DO
341!            ENDIF
342!            !
343!            IF( northern_side ) THEN
344!               ztab(i1:i2,jpj,:) = z1 * ptab(i1:i2,jpj,:) + z2 * ptab(i1:i2,jpj-1,:)
345!               DO ji = imin, imax
346!                  rswitch = 0.
347!                  IF( v_ice(ji,jpj-2) > 0._wp ) rswitch = 1.
348!                  ztab(ji,jpj-1,:) = ( 1. - vmask(ji,jpj-2,1) ) * ztab(ji,jpj,:)  &
349!                     &               +      vmask(ji,jpj-2,1)   *  &
350!                     &               ( (1. - rswitch) * ( z4 * ztab(ji,jpj  ,:) + z3 * ztab(ji,jpj-2,:) ) &
351!                     &                 +     rswitch  * ( z6 * ztab(ji,jpj-2,:) + z5 * ztab(ji,jpj  ,:) + z7 * ztab(ji,jpj-3,:) ) )
352!                  ztab(ji,jpj-1,:) = ztab(ji,jpj-1,:) * tmask(ji,jpj-1,1)
353!               END DO
354!            END IF
355!            !
356!            IF( western_side) THEN
357!               ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:)
358!               DO jj = jmin, jmax
359!                  rswitch = 0.
360!                  IF( u_ice(2,jj) < 0._wp ) rswitch = 1.
361!                  ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  &
362!                     &           +      umask(2,jj,1)   *   &
363!                     &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) &
364!                     &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) )
365!                  ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1)
366!               END DO
367!            ENDIF
368!            !
369!            IF( southern_side ) THEN
370!               ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:)
371!               DO ji = imin, imax
372!                  rswitch = 0.
373!                  IF( v_ice(ji,2) < 0._wp ) rswitch = 1.
374!                  ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  &
375!                     &           +      vmask(ji,2,1)   *  &
376!                     &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) &
377!                     &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) )
378!                  ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1)
379!               END DO
380!            END IF
381!            !
382!            ! Treatment of corners
383!            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(jpi-1,2    ,:) = ptab(jpi-1,    2,:)   ! East south
384!            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(jpi-1,jpj-1,:) = ptab(jpi-1,jpj-1,:)   ! East north
385!            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(    2,    2,:) = ptab(    2,    2,:)   ! West south
386!            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(    2,jpj-1,:) = ptab(    2,jpj-1,:)   ! West north
387!           
388!            ! retrieve ice tracers
389!            jm = 1
390!            DO jl = 1, jpl
391!               !
392!               DO jj = j1, j2
393!                  DO ji = i1, i2
394!                     a_i (ji,jj,jl) = ztab(ji,jj,jm  ) * tmask(ji,jj,1)
395!                     v_i (ji,jj,jl) = ztab(ji,jj,jm+1) * tmask(ji,jj,1)
396!                     v_s (ji,jj,jl) = ztab(ji,jj,jm+2) * tmask(ji,jj,1)
397!                     sv_i(ji,jj,jl) = ztab(ji,jj,jm+3) * tmask(ji,jj,1)
398!                     oa_i(ji,jj,jl) = ztab(ji,jj,jm+4) * tmask(ji,jj,1)
399!                     a_ip(ji,jj,jl) = ztab(ji,jj,jm+5) * tmask(ji,jj,1)
400!                     v_ip(ji,jj,jl) = ztab(ji,jj,jm+6) * tmask(ji,jj,1)
401!                     v_il(ji,jj,jl) = ztab(ji,jj,jm+7) * tmask(ji,jj,1)
402!                     t_su(ji,jj,jl) = ztab(ji,jj,jm+8) * tmask(ji,jj,1)
403!                  END DO
404!               END DO
405!               jm = jm + 9
406!               !
407!               DO jk = 1, nlay_s
408!                  e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
409!                  jm = jm + 1
410!               END DO
411!               !
412!               DO jk = 1, nlay_i
413!                  e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
414!                  jm = jm + 1
415!               END DO
416!               !
417!            END DO
418!         
419!         ENDIF  ! nbghostcells=1
420         
421         DO jl = 1, jpl
422            WHERE( tmask(i1:i2,j1:j2,1) == 0._wp )   t_su(i1:i2,j1:j2,jl) = rt0   ! to avoid a division by 0 in sbcblk.F90
423         END DO
424         !
425      ENDIF
426     
427      DEALLOCATE( ztab )
428      !
429   END SUBROUTINE interp_tra_ice
430
431#else
432   !!----------------------------------------------------------------------
433   !!   Empty module                                             no sea-ice
434   !!----------------------------------------------------------------------
435CONTAINS
436   SUBROUTINE agrif_ice_interp_empty
437      WRITE(*,*)  'agrif_ice_interp : You should not have seen this print! error?'
438   END SUBROUTINE agrif_ice_interp_empty
439#endif
440
441   !!======================================================================
442END MODULE agrif_ice_interp
Note: See TracBrowser for help on using the repository browser.