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/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST – NEMO

source: NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_ice_interp.F90 @ 13334

Last change on this file since 13334 was 13334, checked in by jchanut, 4 years ago

finish bypassing ocean/ice initialization with AGRIF, #2222, #2129
  • Property svn:keywords set to Id
File size: 20.0 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) = t_su(i1:i2,j1:j2,jl)
230            jm = jm + 8
231            DO jk = 1, nlay_s
232               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
233            END DO
234            DO jk = 1, nlay_i
235               ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl)   ;   jm = jm + 1
236            END DO
237         END DO
238         
239         DO jk = k1, k2
240            WHERE( tmask(i1:i2,j1:j2,1) == 0._wp )   ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValue
241         END DO
242         !
243      ELSE               ! child grid
244         !
245!         IF( nbghostcells > 1 ) THEN   ! ==> The easiest interpolation is used
246            !
247            jm = 1
248            DO jl = 1, jpl
249               !
250               DO jj = j1, j2
251                  DO ji = i1, i2
252                     a_i (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1)
253                     v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1)
254                     v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1)
255                     sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1)
256                     oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1)
257                     a_ip(ji,jj,jl) = ptab(ji,jj,jm+5) * tmask(ji,jj,1)
258                     v_ip(ji,jj,jl) = ptab(ji,jj,jm+6) * tmask(ji,jj,1)
259                     t_su(ji,jj,jl) = ptab(ji,jj,jm+7) * tmask(ji,jj,1)
260                  END DO
261               END DO
262               jm = jm + 8
263               !
264               DO jk = 1, nlay_s
265                  e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
266                  jm = jm + 1
267               END DO
268               !
269               DO jk = 1, nlay_i
270                  e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
271                  jm = jm + 1
272               END DO
273               !
274            END DO
275            !
276!!==> clem: this interpolation does not work because it creates negative values, due
277!!          to negative coefficients when mixing points (for ex. z7)
278!!
279!         ELSE                          ! ==> complex interpolation (only one ghost cell available)
280!            !! Use a more complex interpolation since we mix solutions over a couple of grid points
281!            !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...)
282!            ! record ztab
283!            jm = 1
284!            DO jl = 1, jpl
285!               ztab(:,:,jm  ) = a_i (:,:,jl)
286!               ztab(:,:,jm+1) = v_i (:,:,jl)
287!               ztab(:,:,jm+2) = v_s (:,:,jl)
288!               ztab(:,:,jm+3) = sv_i(:,:,jl)
289!               ztab(:,:,jm+4) = oa_i(:,:,jl)
290!               ztab(:,:,jm+5) = a_ip(:,:,jl)
291!               ztab(:,:,jm+6) = v_ip(:,:,jl)
292!               ztab(:,:,jm+7) = t_su(:,:,jl)
293!               jm = jm + 8
294!               DO jk = 1, nlay_s
295!                  ztab(:,:,jm) = e_s(:,:,jk,jl)
296!                  jm = jm + 1
297!               END DO
298!               DO jk = 1, nlay_i
299!                  ztab(:,:,jm) = e_i(:,:,jk,jl)
300!                  jm = jm + 1
301!               END DO
302!               !
303!            END DO
304!            !
305!            ! borders of the domain
306!            western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2)
307!            southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2)
308!            !
309!            ! spatial smoothing
310!            zrhox = Agrif_Rhox()
311!            z1 =      ( zrhox - 1. ) * 0.5
312!            z3 =      ( zrhox - 1. ) / ( zrhox + 1. )
313!            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
314!            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
315!            z2 = 1. - z1
316!            z4 = 1. - z3
317!            z5 = 1. - z6 - z7
318!            !
319!            ! Remove corners
320!            imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2
321!            IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3
322!            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = jpj-2
323!            IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3
324!            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = jpi-2
325!
326!            ! smoothed fields
327!            IF( eastern_side ) THEN
328!               ztab(jpi,j1:j2,:) = z1 * ptab(jpi,j1:j2,:) + z2 * ptab(jpi-1,j1:j2,:)
329!               DO jj = jmin, jmax
330!                  rswitch = 0.
331!                  IF( u_ice(jpi-2,jj) > 0._wp ) rswitch = 1.
332!                  ztab(jpi-1,jj,:) = ( 1. - umask(jpi-2,jj,1) ) * ztab(jpi,jj,:)  &
333!                     &               +      umask(jpi-2,jj,1)   *  &
334!                     &               ( (1. - rswitch) * ( z4 * ztab(jpi  ,jj,:) + z3 * ztab(jpi-2,jj,:) )  &
335!                     &                 +     rswitch  * ( z6 * ztab(jpi-2,jj,:) + z5 * ztab(jpi  ,jj,:) + z7 * ztab(jpi-3,jj,:) ) )
336!                  ztab(jpi-1,jj,:) = ztab(jpi-1,jj,:) * tmask(jpi-1,jj,1)
337!               END DO
338!            ENDIF
339!            !
340!            IF( northern_side ) THEN
341!               ztab(i1:i2,jpj,:) = z1 * ptab(i1:i2,jpj,:) + z2 * ptab(i1:i2,jpj-1,:)
342!               DO ji = imin, imax
343!                  rswitch = 0.
344!                  IF( v_ice(ji,jpj-2) > 0._wp ) rswitch = 1.
345!                  ztab(ji,jpj-1,:) = ( 1. - vmask(ji,jpj-2,1) ) * ztab(ji,jpj,:)  &
346!                     &               +      vmask(ji,jpj-2,1)   *  &
347!                     &               ( (1. - rswitch) * ( z4 * ztab(ji,jpj  ,:) + z3 * ztab(ji,jpj-2,:) ) &
348!                     &                 +     rswitch  * ( z6 * ztab(ji,jpj-2,:) + z5 * ztab(ji,jpj  ,:) + z7 * ztab(ji,jpj-3,:) ) )
349!                  ztab(ji,jpj-1,:) = ztab(ji,jpj-1,:) * tmask(ji,jpj-1,1)
350!               END DO
351!            END IF
352!            !
353!            IF( western_side) THEN
354!               ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:)
355!               DO jj = jmin, jmax
356!                  rswitch = 0.
357!                  IF( u_ice(2,jj) < 0._wp ) rswitch = 1.
358!                  ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  &
359!                     &           +      umask(2,jj,1)   *   &
360!                     &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) &
361!                     &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) )
362!                  ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1)
363!               END DO
364!            ENDIF
365!            !
366!            IF( southern_side ) THEN
367!               ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:)
368!               DO ji = imin, imax
369!                  rswitch = 0.
370!                  IF( v_ice(ji,2) < 0._wp ) rswitch = 1.
371!                  ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  &
372!                     &           +      vmask(ji,2,1)   *  &
373!                     &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) &
374!                     &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) )
375!                  ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1)
376!               END DO
377!            END IF
378!            !
379!            ! Treatment of corners
380!            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(jpi-1,2    ,:) = ptab(jpi-1,    2,:)   ! East south
381!            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(jpi-1,jpj-1,:) = ptab(jpi-1,jpj-1,:)   ! East north
382!            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(    2,    2,:) = ptab(    2,    2,:)   ! West south
383!            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(    2,jpj-1,:) = ptab(    2,jpj-1,:)   ! West north
384!           
385!            ! retrieve ice tracers
386!            jm = 1
387!            DO jl = 1, jpl
388!               !
389!               DO jj = j1, j2
390!                  DO ji = i1, i2
391!                     a_i (ji,jj,jl) = ztab(ji,jj,jm  ) * tmask(ji,jj,1)
392!                     v_i (ji,jj,jl) = ztab(ji,jj,jm+1) * tmask(ji,jj,1)
393!                     v_s (ji,jj,jl) = ztab(ji,jj,jm+2) * tmask(ji,jj,1)
394!                     sv_i(ji,jj,jl) = ztab(ji,jj,jm+3) * tmask(ji,jj,1)
395!                     oa_i(ji,jj,jl) = ztab(ji,jj,jm+4) * tmask(ji,jj,1)
396!                     a_ip(ji,jj,jl) = ztab(ji,jj,jm+5) * tmask(ji,jj,1)
397!                     v_ip(ji,jj,jl) = ztab(ji,jj,jm+6) * tmask(ji,jj,1)
398!                     t_su(ji,jj,jl) = ztab(ji,jj,jm+7) * tmask(ji,jj,1)
399!                  END DO
400!               END DO
401!               jm = jm + 8
402!               !
403!               DO jk = 1, nlay_s
404!                  e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
405!                  jm = jm + 1
406!               END DO
407!               !
408!               DO jk = 1, nlay_i
409!                  e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
410!                  jm = jm + 1
411!               END DO
412!               !
413!            END DO
414!         
415!         ENDIF  ! nbghostcells=1
416         
417         DO jl = 1, jpl
418            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
419         END DO
420         !
421      ENDIF
422     
423      DEALLOCATE( ztab )
424      !
425   END SUBROUTINE interp_tra_ice
426
427#else
428   !!----------------------------------------------------------------------
429   !!   Empty module                                             no sea-ice
430   !!----------------------------------------------------------------------
431CONTAINS
432   SUBROUTINE agrif_ice_interp_empty
433      WRITE(*,*)  'agrif_ice_interp : You should not have seen this print! error?'
434   END SUBROUTINE agrif_ice_interp_empty
435#endif
436
437   !!======================================================================
438END MODULE agrif_ice_interp
Note: See TracBrowser for help on using the repository browser.