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_lim2_interp.F90 in branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90 @ 4785

Last change on this file since 4785 was 4785, checked in by rblod, 10 years ago

dev_r4765_CNRS_agrif: First update of AGRIF for dynamic only (_flt and _ts), see ticket #1380 and associated wiki page
  • Property svn:keywords set to Id
File size: 22.3 KB
Line 
1MODULE agrif_lim2_interp
2   !!======================================================================
3   !!                       ***  MODULE agrif_lim2_update ***
4   !! Nesting module :  update surface ocean boundary condition over ice
5   !!                   from a child grif
6   !! Sea-Ice model  :  LIM 2.0 Sea ice model time-stepping
7   !!======================================================================
8   !! History :  2.0   !  04-2008  (F. Dupont)  initial version
9   !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP
10   !!----------------------------------------------------------------------
11#undef toto
12#if defined key_agrif && defined key_lim2 
13   !!----------------------------------------------------------------------
14   !!   'key_lim2'  :                                 LIM 2.0 sea-ice model
15   !!   'key_agrif' :                                 AGRIF library
16   !!----------------------------------------------------------------------
17   !!   agrif_interp_lim2   : update sea-ice model on boundaries or total
18   !!                         sea-ice area
19   !!  agrif_rhg_lim2_load  : interpolcation of ice velocities using Agrif
20   !!  agrif_rhg_lim2       : sub-interpolation of ice velocities for both
21   !!                         splitting time and sea-ice time step
22   !!  agrif_interp_u_ice   : atomic routine to interpolate u_ice
23   !!  agrif_interp_u_ice   : atomic routine to interpolate v_ice
24   !!  agrif_trp_lim2_load  : interpolcation of ice properties using Agrif
25   !!  agrif_trp_lim2       : sub-interpolation of ice properties for 
26   !!                         sea-ice time step
27   !!  agrif_interp_u_ice   : atomic routine to interpolate ice properties
28   !!----------------------------------------------------------------------
29   USE par_oce
30   USE dom_oce
31   USE sbc_oce
32   USE ice_2
33   USE dom_ice_2
34   USE agrif_ice
35
36   IMPLICIT NONE
37   PRIVATE
38
39   PUBLIC agrif_rhg_lim2_load, agrif_rhg_lim2
40   PUBLIC agrif_trp_lim2_load, agrif_trp_lim2
41   PUBLIC interp_u_ice, interp_v_ice
42   PUBLIC interp_adv_ice
43
44   !!----------------------------------------------------------------------
45   !! NEMO/NST 3.4 , NEMO Consortium (2012)
46   !! $Id$
47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49
50CONTAINS
51
52# if defined key_lim2_vp
53   SUBROUTINE agrif_rhg_lim2_load
54      !!-----------------------------------------------------------------------
55      !!              *** ROUTINE agrif_rhg_lim2_load ***
56      !!
57      !!  ** Method  : need a special routine for dealing with exchanging data
58      !! between the child and parent grid during ice step
59      !!
60      !!-----------------------------------------------------------------------
61      !
62      IF (Agrif_Root()) RETURN
63
64      Agrif_SpecialValue=0.
65      Agrif_UseSpecialValue = .FALSE.
66      u_ice_nst(:,:) = 0.
67      v_ice_nst(:,:) = 0.
68#undef toto
69#ifdef toto
70      CALL Agrif_Bc_variable( u_ice_nst, u_ice_id ,procname=interp_u_ice, calledweight=1. )
71      CALL Agrif_Bc_variable( v_ice_nst, v_ice_id ,procname=interp_v_ice, calledweight=1. )
72#endif
73      Agrif_SpecialValue=0.
74      Agrif_UseSpecialValue = .FALSE.
75      !
76   END SUBROUTINE agrif_rhg_lim2_load
77
78
79   SUBROUTINE agrif_rhg_lim2(pu_n,pv_n)
80      !!-----------------------------------------------------------------------
81      !!                 *** ROUTINE agrif_rhg_lim2 ***
82      !!
83      !!  ** Method  : we feel the boundaries with values stored above
84      !!-----------------------------------------------------------------------
85      REAL(wp), DIMENSION(jpi,0:jpj+1), INTENT(inout) :: pu_n, pv_n
86      !!
87      REAL(wp) :: zrhox, zrhoy
88      INTEGER :: ji,jj
89      !!-----------------------------------------------------------------------
90      !
91      IF (Agrif_Root()) RETURN
92
93      zrhox = Agrif_Rhox()
94      zrhoy = Agrif_Rhoy()
95
96      IF((nbondi == -1).OR.(nbondi == 2)) THEN
97         DO jj=2,jpj
98            pu_n(3,jj) = u_ice_nst(3,jj)/(zrhoy*e2f(2,jj-1))*tmu(3,jj)
99         END DO
100         DO jj=2,jpj
101            pv_n(3,jj) = v_ice_nst(3,jj)/(zrhox*e1f(2,jj-1))*tmu(3,jj)
102         END DO
103      ENDIF
104
105      IF((nbondi == 1).OR.(nbondi == 2)) THEN
106         DO jj=2,jpj
107            pu_n(nlci-1,jj) = u_ice_nst(nlci-1,jj)/(zrhoy*e2f(nlci-2,jj-1))*tmu(nlci-1,jj)
108         END DO
109         DO jj=2,jpj
110            pv_n(nlci-1,jj) = v_ice_nst(nlci-1,jj)/(zrhox*e1f(nlci-2,jj-1))*tmu(nlci-1,jj)
111         END DO
112      ENDIF
113
114      IF((nbondj == -1).OR.(nbondj == 2)) THEN
115         DO ji=2,jpi
116            pv_n(ji,3) = v_ice_nst(ji,3)/(zrhox*e1f(ji-1,2))*tmu(ji,3)
117         END DO
118         DO ji=2,jpi
119            pu_n(ji,3) = u_ice_nst(ji,3)/(zrhoy*e2f(ji-1,2))*tmu(ji,3)
120         END DO
121      ENDIF
122
123      IF((nbondj == 1).OR.(nbondj == 2)) THEN
124         DO ji=2,jpi
125            pv_n(ji,nlcj-1) = v_ice_nst(ji,nlcj-1)/(zrhox*e1f(ji-1,nlcj-2))*tmu(ji,nlcj-1)
126         END DO
127         DO ji=2,jpi
128            pu_n(ji,nlcj-1) = u_ice_nst(ji,nlcj-1)/(zrhoy*e2f(ji-1,nlcj-2))*tmu(ji,nlcj-1)
129         END DO
130      ENDIF
131      !
132   END SUBROUTINE agrif_rhg_lim2
133
134#else
135   SUBROUTINE agrif_rhg_lim2_load
136      !!-----------------------------------------------------------------------
137      !!              *** ROUTINE agrif_rhg_lim2_load ***
138      !!
139      !!  ** Method  : need a special routine for dealing with exchanging data
140      !!  between the child and parent grid during ice step
141      !!               we interpolate and store the boundary if needed, ie if
142      !!  we are in inside a new parent ice time step
143      !!-----------------------------------------------------------------------
144      REAL(wp), DIMENSION(jpi,jpj) :: zuice, zvice
145      INTEGER :: ji,jj
146      REAL(wp) :: zrhox, zrhoy
147      !!-----------------------------------------------------------------------
148      !
149      IF (Agrif_Root()) RETURN
150
151      IF( lim_nbstep == 1. ) THEN
152         !
153         ! switch old values by hand
154         u_ice_oe(:,:,1) =  u_ice_oe(:,:,2)
155         v_ice_oe(:,:,1) =  v_ice_oe(:,:,2)
156         u_ice_sn(:,:,1) =  u_ice_sn(:,:,2)
157         v_ice_sn(:,:,1) =  v_ice_sn(:,:,2)
158         ! interpolation of boundaries (called weight prevents AGRIF interpolation)
159         Agrif_SpecialValue=-9999.
160         Agrif_UseSpecialValue = .TRUE.
161         zuice = 0.
162         zvice = 0.
163#undef toto
164#ifdef toto
165         CALL Agrif_Bc_variable(zuice,u_ice_id,procname=interp_u_ice, calledweight=1.)
166         CALL Agrif_Bc_variable(zvice,v_ice_id,procname=interp_v_ice, calledweight=1.)
167#endif
168         Agrif_SpecialValue=0.
169         Agrif_UseSpecialValue = .FALSE.
170         ! 
171         zrhox = agrif_rhox() ;    zrhoy = agrif_rhoy()     
172         zuice(:,:) =  zuice(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)
173         zvice(:,:) =  zvice(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)
174         ! fill  boundaries
175         DO jj = 1, jpj
176            DO ji = 1, 2
177               u_ice_oe(ji,  jj,2) = zuice(ji       ,jj) 
178               u_ice_oe(ji+2,jj,2) = zuice(nlci+ji-3,jj)
179            END DO
180         END DO
181         DO jj = 1, jpj
182            v_ice_oe(2,jj,2) = zvice(2     ,jj) 
183            v_ice_oe(4,jj,2) = zvice(nlci-1,jj)
184         END DO
185         DO ji = 1, jpi
186            u_ice_sn(ji,2,2) = zuice(ji,2     ) 
187            u_ice_sn(ji,4,2) = zuice(ji,nlcj-1)
188         END DO
189         DO jj = 1, 2
190            DO ji = 1, jpi
191               v_ice_sn(ji,jj  ,2) = zvice(ji,jj       ) 
192               v_ice_sn(ji,jj+2,2) = zvice(ji,nlcj+jj-3)
193            END DO
194         END DO
195         !
196      ENDIF
197      !
198   END SUBROUTINE agrif_rhg_lim2_load
199
200
201   SUBROUTINE agrif_rhg_lim2( kiter, kitermax, cd_type)
202      !!-----------------------------------------------------------------------
203      !!                 *** ROUTINE agrif_rhg_lim2  ***
204      !!
205      !!  ** Method  : simple call to atomic routines using stored values to
206      !!  fill the boundaries depending of the position of the point and
207      !!  computing factor for time interpolation
208      !!-----------------------------------------------------------------------
209      INTEGER, INTENT(in) :: kiter, kitermax
210      CHARACTER(len=1), INTENT( in ) :: cd_type
211      !!   
212      REAL(wp) :: zalpha, zbeta
213      !!-----------------------------------------------------------------------
214      !
215      IF (Agrif_Root()) RETURN
216      zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc))
217      zbeta  = REAL(kiter,wp) / kitermax
218      zbeta = zalpha * zbeta
219      SELECT CASE(cd_type)
220      CASE('U')
221         CALL ParcoursU( zbeta )
222      CASE('V')
223         CALL ParcoursV( zbeta )
224      END SELECT
225      !
226   END SUBROUTINE agrif_rhg_lim2
227
228
229   SUBROUTINE ParcoursU( pbeta )
230      !!-----------------------------------------------------------------------
231      !!                    *** ROUTINE parcoursU ***
232      !!
233      !!  ** Method  : time and spatial interpolation for U-point using values
234      !!  interpolated from the coarse grid and inside dvalues     
235      !!-----------------------------------------------------------------------
236      REAL(wp), INTENT(in) :: pbeta
237      !!
238      INTEGER :: ji, jj
239      !!-----------------------------------------------------------------------
240      !
241      IF((nbondi == -1).OR.(nbondi == 2)) THEN
242         DO jj=1,jpj
243            DO ji=1,2
244               u_ice(ji,jj) = (1-pbeta) * u_ice_oe(ji,jj,1) + pbeta * u_ice_oe(ji,jj,2)
245            END DO
246         END DO
247         DO jj=1,jpj
248            u_ice(2,jj) = 0.25*(u_ice(1,jj)+2.*u_ice(2,jj)+u_ice(3,jj))
249            u_ice(2,jj) = u_ice(2,jj) * umask(2,jj,1)
250         END DO
251      ENDIF
252
253      IF((nbondi == 1).OR.(nbondi == 2)) THEN
254         DO jj=1,jpj
255            DO ji=1,2
256               u_ice(nlci+ji-3,jj) = (1-pbeta) * u_ice_oe(ji+2,jj,1) + pbeta * u_ice_oe(ji+2,jj,2)
257            END DO
258         END DO
259         DO jj=1,jpj
260            u_ice(nlci-2,jj) = 0.25*(u_ice(nlci-3,jj)+2.*u_ice(nlci-2,jj)+u_ice(nlci-1,jj))
261            u_ice(nlci-2,jj) = u_ice(nlci-2,jj) * umask(nlci-2,jj,1)
262         END DO
263      ENDIF
264
265      IF((nbondj == -1).OR.(nbondj == 2)) THEN
266         DO ji=1,jpi
267            u_ice(ji,2) = (1-pbeta) * u_ice_sn(ji,2,1) + pbeta * u_ice_sn(ji,2,2)
268            u_ice(ji,2) = u_ice(ji,2)*umask(ji,2,1)
269         END DO
270      ENDIF
271
272      IF((nbondj == 1).OR.(nbondj == 2)) THEN
273         DO ji=1,jpi
274            u_ice(ji,nlcj-1) = (1-pbeta) * u_ice_sn(ji,4,1) + pbeta * u_ice_sn(ji,4,2)
275            u_ice(ji,nlcj-1) = u_ice(ji,nlcj-1)*umask(ji,nlcj-1,1)
276         END DO
277      ENDIF
278      !
279   END SUBROUTINE ParcoursU
280
281
282   SUBROUTINE ParcoursV( pbeta )
283      !!-----------------------------------------------------------------------
284      !!                    *** ROUTINE parcoursV ***
285      !!
286      !!  ** Method  : time and spatial interpolation for V-point using values
287      !!  interpolated from the coarse grid and inside dvalues     
288      !!-----------------------------------------------------------------------
289      REAL(wp), INTENT(in) :: pbeta
290      !!
291      INTEGER :: ji, jj
292      !!-----------------------------------------------------------------------
293      !
294      IF((nbondi == -1).OR.(nbondi == 2)) THEN
295         DO jj=1,jpj
296            v_ice(2,jj) = (1-pbeta) * v_ice_oe(2,jj,1) + pbeta * v_ice_oe(2,jj,2)
297            v_ice(2,jj) = v_ice(2,jj) * vmask(2,jj,1)
298         END DO
299      ENDIF
300
301      IF((nbondi == 1).OR.(nbondi == 2)) THEN
302         DO jj=1,jpj
303            v_ice(nlci-1,jj) = (1-pbeta) * v_ice_oe(4,jj,1) + pbeta * v_ice_oe(4,jj,2)
304            v_ice(nlci-1,jj) = v_ice(nlci-1,jj)*vmask(nlci-1,jj,1)
305         END DO
306      ENDIF
307
308      IF((nbondj == -1).OR.(nbondj == 2)) THEN
309         DO jj=1,2
310            DO ji=1,jpi
311               v_ice(ji,jj) = (1-pbeta) * v_ice_sn(ji,jj,1) + pbeta * v_ice_sn(ji,jj,2)
312            END DO
313         END DO
314         DO ji=1,jpi
315            v_ice(ji,2)=0.25*(v_ice(ji,1)+2.*v_ice(ji,2)+v_ice(ji,3))
316            v_ice(ji,2)=v_ice(ji,2)*vmask(ji,2,1)
317         END DO
318      ENDIF
319
320      IF((nbondj == 1).OR.(nbondj == 2)) THEN
321         DO jj=1,2
322            DO ji=1,jpi
323               v_ice(ji,nlcj+jj-3) = (1-pbeta) * v_ice_sn(ji,jj+2,1) + pbeta * v_ice_sn(ji,jj+2,2)
324            END DO
325         END DO
326         DO ji=1,jpi
327            v_ice(ji,nlcj-2)=0.25*(v_ice(ji,nlcj-3)+2.*v_ice(ji,nlcj-2)+v_ice(ji,nlcj-1))
328            v_ice(ji,nlcj-2) = v_ice(ji,nlcj-2) * vmask(ji,nlcj-2,1)
329         END DO
330      ENDIF
331      !
332   END SUBROUTINE ParcoursV
333# endif
334   SUBROUTINE agrif_trp_lim2_load
335      !!-----------------------------------------------------------------------
336      !!                 *** ROUTINE agrif_trp_lim2_load ***
337      !!
338      !!  ** Method  : need a special routine for dealing with exchanging data
339      !!  between the child and parent grid during ice step
340      !!               we interpolate and store the boundary if needed, ie if
341      !!  we are in inside a new parent ice time step
342     !!-----------------------------------------------------------------------
343      REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 
344      INTEGER :: ji,jj,jn
345      !!-----------------------------------------------------------------------
346      !
347      IF (Agrif_Root()) RETURN
348      IF( lim_nbstep == 1. ) THEN
349         !
350         ! switch old values
351         adv_ice_oe(:,:,:,1) =  adv_ice_oe(:,:,:,2)
352         adv_ice_sn(:,:,:,1) =  adv_ice_sn(:,:,:,2)
353         ! interpolation of boundaries
354         ztab(:,:,:) = 0.
355         Agrif_SpecialValue=-9999.
356         Agrif_UseSpecialValue = .TRUE.
357#undef toto
358#ifdef toto
359         CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. )
360#endif
361         Agrif_SpecialValue=0.
362         Agrif_UseSpecialValue = .FALSE.
363         ! 
364         ! fill  boundaries
365         DO jn =1,7
366            DO jj = 1, jpj
367               DO ji=1,2
368                  adv_ice_oe(ji  ,jj,jn,2) = ztab(ji       ,jj,jn) 
369                  adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn)
370               END DO
371            END DO
372         END DO
373
374         Do jn =1,7
375            Do jj =1,2
376               DO ji = 1, jpi
377                  adv_ice_sn(ji,jj  ,jn,2) = ztab(ji,jj       ,jn) 
378                  adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn)
379               END DO
380            END DO
381         END DO
382         !
383      ENDIF
384      !
385   END SUBROUTINE agrif_trp_lim2_load
386
387
388   SUBROUTINE agrif_trp_lim2
389      !!-----------------------------------------------------------------------
390      !!                  *** ROUTINE agrif_trp_lim2 ***
391      !!
392      !!  ** Method  : time coefficient and call to atomic routines
393      !!-----------------------------------------------------------------------
394      INTEGER :: ji,jj,jn
395      REAL(wp) :: zalpha
396      REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 
397      !!-----------------------------------------------------------------------     
398      !
399      IF (Agrif_Root()) RETURN
400
401      zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc))
402      !
403      ztab(:,:,:) = 0.e0
404      DO jn =1,7
405         DO jj =1,2
406            DO ji = 1, jpi
407               ztab(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2) 
408               ztab(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 
409            END DO
410         END DO
411      END DO
412
413      DO jn =1,7
414         DO jj = 1, jpj
415            DO ji=1,2
416               ztab(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2) 
417               ztab(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 
418            END DO
419         END DO
420      END DO
421      !
422      CALL parcoursT( ztab(:,:, 1), frld  )
423      CALL parcoursT( ztab(:,:, 2), hicif )
424      CALL parcoursT( ztab(:,:, 3), hsnif )
425      CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) )
426      CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) )
427      CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) )
428      CALL parcoursT( ztab(:,:, 7), qstoif )
429      !
430   END SUBROUTINE agrif_trp_lim2
431
432
433   SUBROUTINE parcoursT ( pinterp, pfinal )
434      !!-----------------------------------------------------------------------
435      !!                    *** ROUTINE parcoursT ***
436      !!
437      !!  ** Method  : fill boundaries for T points
438      !!-----------------------------------------------------------------------
439      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)    :: pinterp
440      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pfinal
441      !!
442      REAL(wp) :: zbound, zvbord
443      REAL(wp), DIMENSION(jpi,jpj) ::  zui_u, zvi_v
444      INTEGER :: ji, jj
445      !!-----------------------------------------------------------------------
446      !
447      zui_u = 0.e0
448      zvi_v = 0.e0
449      ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions.
450      zbound=0.
451      zvbord = 1.0 + ( 1.0 - zbound )
452#if defined key_lim2_vp
453      DO jj = 1, jpjm1
454         DO ji = 1, jpim1
455            zui_u(ji,jj) = ( u_ice(ji+1,jj  ) + u_ice(ji+1,jj+1) ) / ( MAX( tmu(ji+1,jj  ) + tmu(ji+1,jj+1), zvbord ) )
456            zvi_v(ji,jj) = ( v_ice(ji  ,jj+1) + v_ice(ji+1,jj+1) ) / ( MAX( tmu(ji  ,jj+1) + tmu(ji+1,jj+1), zvbord ) )
457         END DO
458      END DO
459#else
460      zui_u(:,:) = u_ice(:,:)
461      zvi_v(:,:) = v_ice(:,:)
462#endif
463
464      IF((nbondi == -1).OR.(nbondi == 2)) THEN
465         DO jj=1,jpj
466            !            IF (zui_u(2,jj).EQ.0.) THEN
467            !               pfinal (2,jj) = pfinal (1,jj) * tms(2,jj)
468            !            ELSE
469            pfinal(2,jj) = 0.25* pinterp(1,jj) + 0.5 *  pinterp(2,jj) + 0.25 *pfinal(3,jj)
470            !            ENDIF
471         END DO
472      ENDIF
473
474      IF((nbondj == -1).OR.(nbondj == 2)) THEN
475         DO ji=1,jpi
476            !            IF (zvi_v(ji,2).EQ.0.) THEN
477            !               pfinal (ji,2) = pfinal (ji,1) * tms(ji,2)
478            !            ELSE
479            pfinal(ji,2) = 0.25* pinterp(ji,1) + 0.5 *  pinterp(ji,2) + 0.25 *pfinal(ji,3)
480            !            ENDIF
481         END DO
482      ENDIF
483
484
485      IF((nbondi == 1).OR.(nbondi == 2)) THEN
486         DO jj=1,jpj
487            !            IF (zui_u(nlci-2,jj).EQ.0.) THEN
488            !               pfinal(nlci-1,jj) = pfinal (nlci,jj) * tms(nlci-1,jj)
489            !            ELSE
490            pfinal(nlci-1,jj) = 0.25* pinterp(nlci,jj) + 0.5 *  pinterp(nlci-1,jj) + 0.25 *pfinal(nlci-2,jj)
491            !           ENDIF
492         END DO
493      ENDIF
494
495      IF((nbondj == 1).OR.(nbondj == 2)) THEN
496         DO ji=1,jpi
497            !            IF (zvi_v(ji,nlcj-2).EQ.0.) THEN
498            !               pfinal (ji,nlcj-1) =  pfinal(ji,nlcj) * tms(ji,nlcj-1)
499            !            ELSE
500            pfinal(ji,nlcj-1) = 0.25* pinterp(ji,nlcj) + 0.5 *  pinterp(ji,nlcj-1) + 0.25 *pfinal(ji,nlcj-2)
501            !            ENDIF
502         END DO
503      ENDIF
504
505
506      pfinal (:,:) = pfinal (:,:) * tms(:,:)
507      !
508   END SUBROUTINE parcoursT
509
510
511   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 )
512      !!-----------------------------------------------------------------------
513      !!                     *** ROUTINE interp_u_ice ***
514      !!-----------------------------------------------------------------------
515      INTEGER, INTENT(in) :: i1, i2, j1, j2
516      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
517      !!
518      INTEGER :: ji,jj
519      !!-----------------------------------------------------------------------
520      !
521#if defined key_lim2_vp
522      DO jj=MAX(j1,2),j2
523         DO ji=MAX(i1,2),i2
524            IF( tmu(ji,jj) == 0. ) THEN
525               tabres(ji,jj) = -9999.
526            ELSE
527               tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj)
528            ENDIF
529         END DO
530      END DO
531#else
532      DO jj= j1, j2
533         DO ji= i1, i2
534            IF( umask(ji,jj,1) == 0. ) THEN
535               tabres(ji,jj) = -9999.
536            ELSE
537               tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj)
538            ENDIF
539         END DO
540      END DO
541#endif
542   END SUBROUTINE interp_u_ice
543
544
545   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 )
546      !!-----------------------------------------------------------------------
547      !!                    *** ROUTINE interp_v_ice ***
548      !!-----------------------------------------------------------------------     
549      INTEGER, INTENT(in) :: i1, i2, j1, j2
550      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
551      !!
552      INTEGER :: ji, jj
553      !!-----------------------------------------------------------------------
554      !
555#if defined key_lim2_vp
556      DO jj=MAX(j1,2),j2
557         DO ji=MAX(i1,2),i2
558            IF( tmu(ji,jj) == 0. ) THEN
559               tabres(ji,jj) = -9999.
560            ELSE
561               tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj)
562            ENDIF
563         END DO
564      END DO
565#else
566      DO jj= j1 ,j2
567         DO ji = i1, i2
568            IF( vmask(ji,jj,1) == 0. ) THEN
569               tabres(ji,jj) = -9999.
570            ELSE
571               tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj)
572            ENDIF
573         END DO
574      END DO
575#endif
576   END SUBROUTINE interp_v_ice
577
578
579   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 )
580      !!-----------------------------------------------------------------------
581      !!                    *** ROUTINE interp_adv_ice ***                           
582      !!
583      !! ** Purpose : fill an array with  ice variables
584      !!              to be advected
585      !!              put -9999 where no ice for correct extrapolation             
586      !!-----------------------------------------------------------------------
587      INTEGER, INTENT(in) :: i1, i2, j1, j2
588      REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres
589      !!
590      INTEGER :: ji, jj, jk
591      !!-----------------------------------------------------------------------
592      !
593      DO jj=j1,j2
594         DO ji=i1,i2
595            IF( tms(ji,jj) == 0. ) THEN
596               tabres(ji,jj,:) = -9999. 
597            ELSE
598               tabres(ji,jj, 1) = frld  (ji,jj)
599               tabres(ji,jj, 2) = hicif (ji,jj)
600               tabres(ji,jj, 3) = hsnif (ji,jj)
601               tabres(ji,jj, 4) = tbif  (ji,jj,1)
602               tabres(ji,jj, 5) = tbif  (ji,jj,2)
603               tabres(ji,jj, 6) = tbif  (ji,jj,3)
604               tabres(ji,jj, 7) = qstoif(ji,jj)
605            ENDIF
606         END DO
607      END DO
608      !
609   END SUBROUTINE interp_adv_ice
610
611#else
612CONTAINS
613   SUBROUTINE agrif_lim2_interp_empty
614      !!---------------------------------------------
615      !!   *** ROUTINE agrif_lim2_interp_empty ***
616      !!---------------------------------------------
617      WRITE(*,*)  'agrif_lim2_interp : You should not have seen this print! error?'
618   END SUBROUTINE agrif_lim2_interp_empty
619#endif
620END MODULE agrif_lim2_interp
Note: See TracBrowser for help on using the repository browser.