source: branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90 @ 5550

Last change on this file since 5550 was 3680, checked in by rblod, 9 years ago

First commit of the final branch for 2012 (future nemo_3_5), see ticket #1028

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