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

Last change on this file was 15031, checked in by jchanut, 3 years ago

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