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_user.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_user.F90 @ 13961

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

#2222, remove bathy check with AGRIF_DEMO + forgotten change when merging with trunk for ice variables

  • Property svn:keywords set to Id
File size: 51.8 KB
Line 
1#undef UPD_HIGH   /* MIX HIGH UPDATE */
2#define DIV_CONS   /* DIVERGENCE CONS */
3#if defined key_agrif
4   !! * Substitutions
5#  include "do_loop_substitute.h90"
6   !!----------------------------------------------------------------------
7   !! NEMO/NST 4.0 , NEMO Consortium (2018)
8   !! $Id$
9   !! Software governed by the CeCILL license (see ./LICENSE)
10   !!----------------------------------------------------------------------
11   SUBROUTINE agrif_user
12   END SUBROUTINE agrif_user
13
14   
15   SUBROUTINE agrif_before_regridding
16   END SUBROUTINE agrif_before_regridding
17
18   
19   SUBROUTINE Agrif_InitWorkspace
20   END SUBROUTINE Agrif_InitWorkspace
21
22   
23   SUBROUTINE Agrif_InitValues
24      !!----------------------------------------------------------------------
25      !!                 *** ROUTINE Agrif_InitValues ***
26      !!----------------------------------------------------------------------
27      USE nemogcm
28      !!----------------------------------------------------------------------
29      !
30      CALL nemo_init       !* Initializations of each fine grid
31      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices
32      !
33      !                    !* Agrif initialization
34      CALL Agrif_InitValues_cont
35# if defined key_top
36      CALL Agrif_InitValues_cont_top
37# endif
38# if defined key_si3
39      CALL Agrif_InitValues_cont_ice
40# endif
41      !   
42   END SUBROUTINE Agrif_initvalues
43
44   
45   SUBROUTINE agrif_declare_var_ini
46      !!----------------------------------------------------------------------
47      !!                 *** ROUTINE agrif_declare_var_ini ***
48      !!----------------------------------------------------------------------
49      USE agrif_util
50      USE agrif_oce
51      USE par_oce
52      USE zdf_oce 
53      USE oce
54      USE dom_oce
55      !
56      IMPLICIT NONE
57      !
58      INTEGER :: ind1, ind2, ind3, imaxrho
59      INTEGER :: its
60      External :: nemo_mapping
61      !!----------------------------------------------------------------------
62
63! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries
64! The procnames will not be called at these boundaries
65      IF (jperio == 1) THEN
66         CALL Agrif_Set_NearCommonBorderX(.TRUE.)
67         CALL Agrif_Set_DistantCommonBorderX(.TRUE.)
68      ENDIF
69
70      IF ( .NOT. lk_south ) THEN
71         CALL Agrif_Set_NearCommonBorderY(.TRUE.)
72      ENDIF
73
74      IF ( .NOT. lk_north ) THEN
75         CALL Agrif_Set_DistantCommonBorderY(.TRUE.)
76      ENDIF
77
78      ! 1. Declaration of the type of variable which have to be interpolated
79      !---------------------------------------------------------------------
80      ind1 =              nbghostcells 
81      ind2 = nn_hls + 2 + nbghostcells_x
82      ind3 = nn_hls + 2 + nbghostcells_y_s
83      imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
84
85      CALL agrif_declare_variable((/2,2,0  /),(/ind2  ,ind3,0    /),(/'x','y','N'    /),(/1,1,1  /),(/jpi,jpj,jpk    /),        e3t_id)
86      CALL agrif_declare_variable((/2,2,0  /),(/ind2  ,ind3,0    /),(/'x','y','N'    /),(/1,1,1  /),(/jpi,jpj,jpk    /),e3t0_interp_id)
87      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),       mbkt_id)
88      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),        ht0_id)
89   
90      ! Initial or restart velues
91      its = jpts+1
92      CALL agrif_declare_variable((/2,2,0,0/),(/ind2  ,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,its/), tsini_id)
93      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2  /),  uini_id) 
94      CALL agrif_declare_variable((/2,1,0,0/),(/ind2  ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2  /),  vini_id)
95      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),sshini_id)
96      !
97      ! Update location
98      CALL agrif_declare_variable((/2,2/),(/ind2  ,ind3  /),(/'x','y'/),(/1,1/),(/jpi,jpj/), batupd_id)
99     
100      ! 2. Type of interpolation
101      !-------------------------
102      CALL Agrif_Set_bcinterp(        e3t_id,interp =AGRIF_constant)
103      CALL Agrif_Set_bcinterp(e3t0_interp_id,interp =AGRIF_linear  )
104      CALL Agrif_Set_interp  (e3t0_interp_id,interp =AGRIF_linear  )
105      CALL Agrif_Set_bcinterp(       mbkt_id,interp =AGRIF_constant)
106      CALL Agrif_Set_interp  (       mbkt_id,interp =AGRIF_constant)
107      CALL Agrif_Set_bcinterp(        ht0_id,interp =AGRIF_constant)
108      CALL Agrif_Set_interp  (        ht0_id,interp =AGRIF_constant)
109
110      ! Initial fields
111      CALL Agrif_Set_bcinterp( tsini_id,interp =AGRIF_linear  )
112      CALL Agrif_Set_interp  ( tsini_id,interp =AGRIF_linear  )
113      CALL Agrif_Set_bcinterp(  uini_id,interp =AGRIF_linear  )
114      CALL Agrif_Set_interp  (  uini_id,interp =AGRIF_linear  )
115      CALL Agrif_Set_bcinterp(  vini_id,interp =AGRIF_linear  )
116      CALL Agrif_Set_interp  (  vini_id,interp =AGRIF_linear  )
117      CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear  )
118      CALL Agrif_Set_interp  (sshini_id,interp =AGRIF_linear  )
119
120       ! 3. Location of interpolation
121      !-----------------------------
122!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*imaxrho,ind1-1/) ) 
123! JC: check near the boundary only until matching in sponge has been sorted out:
124      CALL Agrif_Set_bc(    e3t_id, (/0,ind1-1/) ) 
125
126      ! extend the interpolation zone by 1 more point than necessary:
127      ! RB check here
128      CALL Agrif_Set_bc( e3t0_interp_id, (/-nn_sponge_len*imaxrho-2,ind1/) )
129      CALL Agrif_Set_bc(        mbkt_id, (/-nn_sponge_len*imaxrho-2,ind1/) )
130      CALL Agrif_Set_bc(         ht0_id, (/-nn_sponge_len*imaxrho-2,ind1/) )
131      CALL Agrif_Set_bc(       tsini_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4
132      CALL Agrif_Set_bc(        uini_id, (/0,ind1-1/) ) 
133      CALL Agrif_Set_bc(        vini_id, (/0,ind1-1/) )
134      CALL Agrif_Set_bc(      sshini_id, (/0,ind1-1/) )
135
136      ! 4. Update type
137      !---------------
138# if defined UPD_HIGH
139      CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Full_Weighting)
140#else
141      CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Average)
142#endif     
143
144   !   CALL Agrif_Set_ExternalMapping(nemo_mapping)
145      !
146   END SUBROUTINE agrif_declare_var_ini
147
148
149   SUBROUTINE Agrif_Init_Domain
150      !!----------------------------------------------------------------------
151      !!                 *** ROUTINE Agrif_Init_Domain ***
152      !!----------------------------------------------------------------------
153      USE agrif_oce_update
154      USE agrif_oce_interp
155      USE agrif_oce_sponge
156      USE Agrif_Util
157      USE oce 
158      USE dom_oce
159      USE zdf_oce
160      USE nemogcm
161      USE agrif_oce
162      !
163      USE lbclnk
164      USE lib_mpp
165      USE in_out_manager
166      !
167      IMPLICIT NONE
168      !
169      !
170      LOGICAL :: check_namelist
171      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 
172      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace
173      INTEGER :: ji, jj, jk
174      INTEGER :: jpk_parent, ierr
175      !!----------------------------------------------------------------------
176   
177     ! CALL Agrif_Declare_Var_ini
178
179      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
180
181      ! Build consistent parent bathymetry and number of levels
182      ! on the child grid
183      Agrif_UseSpecialValue = .FALSE.
184      ht0_parent( :,:) = 0._wp
185      mbkt_parent(:,:) = 0
186      !
187!     CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
188!     CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
189      CALL Agrif_Init_Variable(ht0_id , procname=interpht0 )
190      CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt)
191      !
192      ! Assume step wise change of bathymetry near interface
193      ! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case
194      !       and no refinement
195      DO_2D( 1, 0, 1, 0 )
196         mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj  ), mbkt_parent(ji,jj) )
197         mbkv_parent(ji,jj) = MIN( mbkt_parent(ji  ,jj+1), mbkt_parent(ji,jj) )
198      END_2D
199      IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN
200         DO_2D( 1, 0, 1, 0 )
201            hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) ) * ssumask(ji,jj)
202            hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) ) * ssvmask(ji,jj)
203         END_2D
204      ELSE
205         DO_2D( 1, 0, 1, 0 )
206            hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) )
207            hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) )
208         END_2D
209      ENDIF
210      !
211      CALL lbc_lnk_multi( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp, hv0_parent, 'V', 1.0_wp )
212      DO_2D( 0, 0, 0, 0 )
213         zk(ji,jj) = REAL( mbku_parent(ji,jj), wp )
214      END_2D
215      CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'U', 1.0_wp )
216      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
217      DO_2D( 0, 0, 0, 0 )
218         zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp )
219      END_2D
220      CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'V', 1.0_wp )
221      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
222      !
223      ! Build "intermediate" parent vertical grid on child domain
224      IF ( ln_vert_remap ) THEN
225
226         jpk_parent = Agrif_parent( jpk )
227         ALLOCATE(e3t0_parent(jpi,jpj,jpk_parent), &
228            &     e3u0_parent(jpi,jpj,jpk_parent), &
229            &     e3v0_parent(jpi,jpj,jpk_parent), STAT = ierr) 
230         IF( ierr  > 0 )   CALL ctl_warn('Agrif_Init_Domain: allocation of arrays failed')
231       
232         ! Retrieve expected parent scale factors on child grid:
233         Agrif_UseSpecialValue = .FALSE.
234         e3t0_parent(:,:,:) = 0._wp
235         CALL Agrif_Init_Variable(e3t0_interp_id, procname=interpe3t0_vremap)
236         !
237         ! Deduce scale factors at U and V points:
238         DO_3D( 0, 0, 0, 0, 1, jpk_parent )
239            e3u0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji+1,jj  ,jk))
240            e3v0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji  ,jj+1,jk))
241         END_3D
242
243         ! Assume a step at the bottom except if (pure) s-coordinates
244         IF ( .NOT.Agrif_Parent(ln_sco) ) THEN
245            DO_2D( 1, 0, 1, 0 )
246               jk = mbku_parent(ji,jj)
247               e3u0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji+1,jj  ,jk))
248               jk = mbkv_parent(ji,jj)
249               e3v0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji  ,jj+1,jk))
250            END_2D
251         ENDIF
252
253         CALL lbc_lnk_multi( 'Agrif_Init_Domain', e3u0_parent, 'U', 1.0_wp, e3v0_parent, 'V', 1.0_wp )
254      ENDIF
255
256      ! check if masks and bathymetries match
257      IF(ln_chk_bathy) THEN
258         Agrif_UseSpecialValue = .FALSE.
259         !
260         IF(lwp) WRITE(numout,*) ' '
261         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
262         !
263         kindic_agr = 0
264         IF( .NOT. ln_vert_remap ) THEN
265            !
266            ! check if tmask and vertical scale factors agree with parent in sponge area:
267            CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
268            !
269         ELSE
270            !
271            ! In case of vertical interpolation, check only that total depths agree between child and parent:
272                 
273            CALL Agrif_check_bat( kindic_agr )           
274
275            CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr )
276            IF( kindic_agr /= 0 ) THEN
277               CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
278            ELSE
279               IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'
280               IF(lwp) WRITE(numout,*) ' '
281            ENDIF 
282         ENDIF
283      ENDIF
284      !
285      WHERE (ssumask(:,:) == 0._wp) mbku_parent(:,:) = 0
286      WHERE (ssvmask(:,:) == 0._wp) mbkv_parent(:,:) = 0
287      WHERE (ssmask(:,:)  == 0._wp) mbkt_parent(:,:) = 0
288      !
289   END SUBROUTINE Agrif_Init_Domain
290
291
292   SUBROUTINE Agrif_InitValues_cont
293      !!----------------------------------------------------------------------
294      !!                 *** ROUTINE Agrif_InitValues_cont ***
295      !!
296      !! ** Purpose ::   Declaration of variables to be interpolated
297      !!----------------------------------------------------------------------
298      USE agrif_oce_update
299      USE agrif_oce_interp
300      USE agrif_oce_sponge
301      USE Agrif_Util
302      USE oce 
303      USE dom_oce
304      USE zdf_oce
305      USE nemogcm
306      USE agrif_oce
307      !
308      USE lbclnk
309      USE lib_mpp
310      USE in_out_manager
311      !
312      IMPLICIT NONE
313      !
314      LOGICAL :: check_namelist
315      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 
316
317      ! 1. Declaration of the type of variable which have to be interpolated
318      !---------------------------------------------------------------------
319      CALL agrif_declare_var
320
321      ! 2. First interpolations of potentially non zero fields
322      !-------------------------------------------------------
323      Agrif_SpecialValue    = 0._wp
324      Agrif_UseSpecialValue = .TRUE.
325      l_vremap              = ln_vert_remap
326
327      CALL Agrif_Bc_variable(ts_interp_id,calledweight=1.,procname=interptsn)
328      CALL Agrif_Sponge
329      tabspongedone_tsn = .FALSE.
330      CALL Agrif_Bc_variable(ts_sponge_id,calledweight=1.,procname=interptsn_sponge)
331      ! reset tsa to zero
332      ts(:,:,:,:,Krhs_a) = 0._wp
333
334      Agrif_UseSpecialValue = ln_spc_dyn
335      use_sign_north = .TRUE.
336      sign_north = -1.
337      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
338      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
339      tabspongedone_u = .FALSE.
340      tabspongedone_v = .FALSE.
341      CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
342      tabspongedone_u = .FALSE.
343      tabspongedone_v = .FALSE.
344      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
345      IF (nn_shift_bar>0) THEN
346         CALL Agrif_Sponge_2d
347         tabspongedone_u = .FALSE.
348         tabspongedone_v = .FALSE.
349         CALL Agrif_Bc_variable(unb_sponge_id,calledweight=1.,procname=interpunb_sponge)
350         tabspongedone_u = .FALSE.
351         tabspongedone_v = .FALSE.
352         CALL Agrif_Bc_variable(vnb_sponge_id,calledweight=1.,procname=interpvnb_sponge)
353      ENDIF
354      use_sign_north = .FALSE.
355      uu(:,:,:,Krhs_a) = 0._wp
356      vv(:,:,:,Krhs_a) = 0._wp
357
358      Agrif_UseSpecialValue = .TRUE.
359      CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
360      hbdy(:,:) = 0._wp
361      ssh(:,:,Krhs_a) = 0._wp
362
363      IF ( ln_dynspg_ts ) THEN
364         Agrif_UseSpecialValue = ln_spc_dyn
365         use_sign_north = .TRUE.
366         sign_north = -1.
367         CALL Agrif_Bc_variable( unb_interp_id,calledweight=1.,procname=interpunb )
368         CALL Agrif_Bc_variable( vnb_interp_id,calledweight=1.,procname=interpvnb )
369         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
370         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
371         use_sign_north = .FALSE.
372         ubdy(:,:) = 0._wp
373         vbdy(:,:) = 0._wp
374      ELSE
375         Agrif_UseSpecialValue = ln_spc_dyn
376         use_sign_north = .TRUE.
377         sign_north = -1.
378         CALL Agrif_Bc_variable( unb_interp_id,calledweight=1.,procname=interpunb )
379         CALL Agrif_Bc_variable( vnb_interp_id,calledweight=1.,procname=interpvnb )
380         use_sign_north = .FALSE.
381         ubdy(:,:) = 0._wp
382         vbdy(:,:) = 0._wp
383      ENDIF
384      Agrif_UseSpecialValue = .FALSE. 
385      l_vremap              = .FALSE.
386
387      !-----------------
388      check_namelist = .TRUE.
389
390      IF( check_namelist ) THEN 
391         ! Check free surface scheme
392         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
393            & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
394            WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts )
395            WRITE(cl_check2,*)  ln_dynspg_ts
396            WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp )
397            WRITE(cl_check4,*)  ln_dynspg_exp
398            CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  &
399                  &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  & 
400                  &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  &
401                  &               'parent grid ln_dynspg_exp :'//cl_check3  ,  &
402                  &               'child  grid ln_dynspg_exp :'//cl_check4  ,  &
403                  &               'those logicals should be identical' )                 
404            STOP
405         ENDIF
406
407         ! Check if identical linear free surface option
408         IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
409            & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
410            WRITE(cl_check1,*)  Agrif_Parent(ln_linssh )
411            WRITE(cl_check2,*)  ln_linssh
412            CALL ctl_stop( 'Incompatible linearized fs option between grids',  &
413                  &               'parent grid ln_linssh  :'//cl_check1     ,  &
414                  &               'child  grid ln_linssh  :'//cl_check2     ,  &
415                  &               'those logicals should be identical' )                 
416            STOP
417         ENDIF
418      ENDIF
419
420   END SUBROUTINE Agrif_InitValues_cont
421
422   SUBROUTINE agrif_declare_var
423      !!----------------------------------------------------------------------
424      !!                 *** ROUTINE agrif_declare_var ***
425      !!----------------------------------------------------------------------
426      USE agrif_util
427      USE agrif_oce
428      USE par_oce
429      USE zdf_oce 
430      USE oce
431      !
432      IMPLICIT NONE
433      !
434      INTEGER :: ind1, ind2, ind3, imaxrho
435      !!----------------------------------------------------------------------
436
437      ! 1. Declaration of the type of variable which have to be interpolated
438      !---------------------------------------------------------------------
439      ind1 =              nbghostcells
440      ind2 = nn_hls + 2 + nbghostcells_x
441      ind3 = nn_hls + 2 + nbghostcells_y_s
442      imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
443
444      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/)  ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_interp_id)
445      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/)  ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_update_id)
446      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/)  ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_sponge_id)
447      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id)
448      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id)
449      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id)
450      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id)
451      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id)
452      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id)
453
454      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/)  ,sshn_id)
455      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_interp_id)
456      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_interp_id)
457      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id)
458      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id)
459      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_sponge_id)
460      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_sponge_id)
461      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id)
462      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id)
463      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_update_id)
464      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_update_id)
465      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/)  ,ub2b_cor_id)
466      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/)  ,vb2b_cor_id)
467!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id)
468!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id)
469
470
471      IF( ln_zdftke.OR.ln_zdfgls ) THEN  ! logical not known at this point
472!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
473!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
474         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id)
475      ENDIF
476     
477      ! 2. Type of interpolation
478      !-------------------------
479      CALL Agrif_Set_bcinterp( ts_interp_id,interp =AGRIF_linear)
480      CALL Agrif_Set_bcinterp( ts_sponge_id,interp =AGRIF_linear)
481
482#if defined DIV_CONS
483      lk_tint2d_notinterp = .TRUE.
484      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
485      CALL Agrif_Set_bcinterp(ub2b_cor_id,interp=AGRIF_constant)
486      CALL Agrif_Set_bcinterp(vb2b_cor_id,interp=AGRIF_constant)
487      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_linearconserv)
488      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_linearconserv,interp2=Agrif_linear)
489#else
490      lk_tint2d_notinterp = .FALSE.
491      CALL Agrif_Set_bcinterp(sshn_id,interp =AGRIF_linear)
492      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
493      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
494#endif
495
496      CALL Agrif_Set_bcinterp(unb_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
497      CALL Agrif_Set_bcinterp(vnb_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
498      CALL Agrif_Set_bcinterp(unb_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
499      CALL Agrif_Set_bcinterp(vnb_sponge_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
500
501      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
502      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
503
504      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm   )
505      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear)
506
507      IF( ln_zdftke.OR.ln_zdfgls )  CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
508   
509
510!      CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant)
511!      CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant)
512
513      ! 3. Location of interpolation
514      !-----------------------------
515      CALL Agrif_Set_bc(  ts_interp_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4
516      CALL Agrif_Set_bc(  un_interp_id, (/0,ind1-1/) ) 
517      CALL Agrif_Set_bc(  vn_interp_id, (/0,ind1-1/) )
518
519      CALL Agrif_Set_bc(  ts_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) )  ! if west,  rhox=3, nn_sponge_len=2
520      CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) )  ! and nbghost=3:
521      CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) )  ! columns 4 to 11
522
523      CALL Agrif_Set_bc(       sshn_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
524      CALL Agrif_Set_bc( unb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
525      CALL Agrif_Set_bc( vnb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
526      CALL Agrif_Set_bc(ub2b_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
527      CALL Agrif_Set_bc(vb2b_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
528      CALL Agrif_Set_bc( unb_sponge_id, (/-(nn_sponge_len+nn_shift_bar)*imaxrho,-imaxrho*nn_shift_bar/) )
529      CALL Agrif_Set_bc( vnb_sponge_id, (/-(nn_sponge_len+nn_shift_bar)*imaxrho,-imaxrho*nn_shift_bar/) )
530      CALL Agrif_Set_bc(   ub2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) )
531      CALL Agrif_Set_bc(   vb2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) )
532      IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
533!!$      CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) ) 
534!!$      CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) ) 
535
536      ! 4. Update type
537      !---------------
538
539# if defined UPD_HIGH
540      CALL Agrif_Set_Updatetype(  ts_interp_id,update  = Agrif_Update_Full_Weighting)
541      CALL Agrif_Set_Updatetype(  un_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
542      CALL Agrif_Set_Updatetype(  vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
543
544      CALL Agrif_Set_Updatetype( unb_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
545      CALL Agrif_Set_Updatetype( vnb_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
546      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
547      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
548      CALL Agrif_Set_Updatetype(       sshn_id,update  = Agrif_Update_Full_Weighting)
549      CALL Agrif_Set_Updatetype(        e3t_id,update  = Agrif_Update_Full_Weighting)
550
551  !    IF( ln_zdftke.OR.ln_zdfgls ) THEN
552!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
553!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
554!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
555   !   ENDIF
556
557#else
558      CALL Agrif_Set_Updatetype(  ts_update_id,update  = AGRIF_Update_Average)
559      CALL Agrif_Set_Updatetype(  un_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
560      CALL Agrif_Set_Updatetype(  vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
561
562      CALL Agrif_Set_Updatetype( unb_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
563      CALL Agrif_Set_Updatetype( vnb_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
564      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
565      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
566      CALL Agrif_Set_Updatetype(       sshn_id,update  = AGRIF_Update_Average)
567      CALL Agrif_Set_Updatetype(        e3t_id,update  = AGRIF_Update_Average)
568
569 !     IF( ln_zdftke.OR.ln_zdfgls ) THEN
570!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
571!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
572!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
573 !     ENDIF
574
575#endif
576      !
577   END SUBROUTINE agrif_declare_var
578
579#if defined key_si3
580   SUBROUTINE Agrif_InitValues_cont_ice
581      !!----------------------------------------------------------------------
582      !!                 *** ROUTINE Agrif_InitValues_cont_ice ***
583      !!----------------------------------------------------------------------
584      USE Agrif_Util
585      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
586      USE ice
587      USE agrif_ice
588      USE in_out_manager
589      USE agrif_ice_interp
590      USE lib_mpp
591      !
592      IMPLICIT NONE
593      !
594      !!----------------------------------------------------------------------
595      ! Controls
596
597      ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
598      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
599      !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
600      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account     
601      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
602
603      ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
604      IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
605         CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
606      ENDIF
607      ! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
608      !----------------------------------------------------------------------
609      nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong)
610      CALL agrif_interp_ice('U') ! interpolation of ice velocities
611      CALL agrif_interp_ice('V') ! interpolation of ice velocities
612      CALL agrif_interp_ice('T') ! interpolation of ice tracers
613      nbstep_ice = 0   
614      !
615   END SUBROUTINE Agrif_InitValues_cont_ice
616
617   
618   SUBROUTINE agrif_declare_var_ice
619      !!----------------------------------------------------------------------
620      !!                 *** ROUTINE agrif_declare_var_ice ***
621      !!----------------------------------------------------------------------
622      USE Agrif_Util
623      USE ice
624      USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s
625      !
626      IMPLICIT NONE
627      !
628      INTEGER :: ind1, ind2, ind3
629      INTEGER :: ipl
630      !!----------------------------------------------------------------------
631      !
632      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
633      !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
634      !           ex.:  position=> 1,1 = not-centered (in i and j)
635      !                            2,2 =     centered (    -     )
636      !                 index   => 1,1 = one ghost line
637      !                            2,2 = two ghost lines
638      !-------------------------------------------------------------------------------------
639      ind1 =              nbghostcells
640      ind2 = nn_hls + 2 + nbghostcells_x
641      ind3 = nn_hls + 2 + nbghostcells_y_s
642      ipl = jpl*(9+nlay_s+nlay_i)
643      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id)
644      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  u_ice_id)
645      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  v_ice_id)
646
647      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_iceini_id)
648      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  u_iceini_id)
649      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  v_iceini_id)
650
651      ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
652      !-----------------------------------
653      CALL Agrif_Set_bcinterp(tra_ice_id, interp  = AGRIF_linear)
654      CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
655      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
656
657      CALL Agrif_Set_bcinterp(tra_iceini_id, interp  = AGRIF_linear)
658      CALL Agrif_Set_interp  (tra_iceini_id, interp  = AGRIF_linear)
659      CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear)
660      CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear)
661      CALL Agrif_Set_bcinterp(v_iceini_id  , interp  = AGRIF_linear)
662      CALL Agrif_Set_interp  (v_iceini_id  , interp  = AGRIF_linear)
663
664      ! 3. Set location of interpolations
665      !----------------------------------
666      CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
667      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
668      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
669
670      CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/))
671      CALL Agrif_Set_bc(u_iceini_id  ,(/0,ind1/))
672      CALL Agrif_Set_bc(v_iceini_id  ,(/0,ind1/))
673
674      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
675      !--------------------------------------------------
676# if defined UPD_HIGH
677      CALL Agrif_Set_Updatetype(tra_ice_id, update  = Agrif_Update_Full_Weighting)
678      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
679      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
680# else
681      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average)
682      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
683      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
684# endif
685
686   END SUBROUTINE agrif_declare_var_ice
687#endif
688
689
690# if defined key_top
691   SUBROUTINE Agrif_InitValues_cont_top
692      !!----------------------------------------------------------------------
693      !!                 *** ROUTINE Agrif_InitValues_cont_top ***
694      !!----------------------------------------------------------------------
695      USE Agrif_Util
696      USE oce 
697      USE dom_oce
698      USE nemogcm
699      USE par_trc
700      USE lib_mpp
701      USE trc
702      USE in_out_manager
703      USE agrif_oce_sponge
704      USE agrif_top_update
705      USE agrif_top_interp
706      USE agrif_top_sponge
707      !
708      IMPLICIT NONE
709      !
710      CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
711      LOGICAL :: check_namelist
712      !!----------------------------------------------------------------------
713
714      ! 1. Declaration of the type of variable which have to be interpolated
715      !---------------------------------------------------------------------
716      CALL agrif_declare_var_top
717
718      ! 2. First interpolations of potentially non zero fields
719      !-------------------------------------------------------
720      Agrif_SpecialValue=0._wp
721      Agrif_UseSpecialValue = .TRUE.
722      CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
723      Agrif_UseSpecialValue = .FALSE.
724      CALL Agrif_Sponge
725      tabspongedone_trn = .FALSE.
726      CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
727      ! reset tsa to zero
728      tra(:,:,:,:) = 0._wp
729
730      ! 3. Some controls
731      !-----------------
732      check_namelist = .TRUE.
733
734      IF( check_namelist ) THEN
735         ! Check time steps
736         IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
737            WRITE(cl_check1,*)  Agrif_Parent(rdt)
738            WRITE(cl_check2,*)  rdt
739            WRITE(cl_check3,*)  rdt*Agrif_Rhot()
740            CALL ctl_stop( 'incompatible time step between grids',   &
741               &               'parent grid value : '//cl_check1    ,   & 
742               &               'child  grid value : '//cl_check2    ,   & 
743               &               'value on child grid should be changed to  &
744               &               :'//cl_check3  )
745         ENDIF
746
747         ! Check run length
748         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
749            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
750            WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
751            WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
752            CALL ctl_warn( 'incompatible run length between grids'               ,   &
753               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
754               &              ' nitend on fine grid will be change to : '//cl_check2    )
755            nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
756            nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
757         ENDIF
758      ENDIF
759      !
760   END SUBROUTINE Agrif_InitValues_cont_top
761
762
763   SUBROUTINE agrif_declare_var_top
764      !!----------------------------------------------------------------------
765      !!                 *** ROUTINE agrif_declare_var_top ***
766      !!----------------------------------------------------------------------
767      USE agrif_util
768      USE agrif_oce
769      USE dom_oce
770      USE trc
771      !!
772      IMPLICIT NONE
773      !
774      INTEGER :: ind1, ind2, ind3, imaxrho
775      !!----------------------------------------------------------------------
776!RB_CMEMS : declare here init for top     
777      ! 1. Declaration of the type of variable which have to be interpolated
778      !---------------------------------------------------------------------
779      ind1 =              nbghostcells
780      ind2 = nn_hls + 2 + nbghostcells_x
781      ind3 = nn_hls + 2 + nbghostcells_y_s
782      imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
783
784      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id)
785      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id)
786
787      ! 2. Type of interpolation
788      !-------------------------
789      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
790      CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
791
792      ! 3. Location of interpolation
793      !-----------------------------
794      CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
795      CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*imaxrho-1,0/))
796
797      ! 4. Update type
798      !---------------
799# if defined UPD_HIGH
800      CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
801#else
802      CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
803#endif
804   !
805   END SUBROUTINE agrif_declare_var_top
806# endif
807   
808
809   SUBROUTINE Agrif_detect( kg, ksizex )
810      !!----------------------------------------------------------------------
811      !!                      *** ROUTINE Agrif_detect ***
812      !!----------------------------------------------------------------------
813      INTEGER, DIMENSION(2) :: ksizex
814      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
815      !!----------------------------------------------------------------------
816      !
817      RETURN
818      !
819   END SUBROUTINE Agrif_detect
820
821   
822   SUBROUTINE agrif_nemo_init
823      !!----------------------------------------------------------------------
824      !!                     *** ROUTINE agrif_init ***
825      !!----------------------------------------------------------------------
826      USE agrif_oce 
827      USE agrif_ice
828      USE dom_oce
829      USE in_out_manager
830      USE lib_mpp
831      !
832      IMPLICIT NONE
833      !
834      INTEGER  ::   ios                 ! Local integer output status for namelist read
835      NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
836                       & ln_spc_dyn, ln_vert_remap, ln_chk_bathy
837      !!--------------------------------------------------------------------------------------
838      !
839      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
840901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist' )
841      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
842902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
843      IF(lwm) WRITE ( numond, namagrif )
844      !
845      IF(lwp) THEN                    ! control print
846         WRITE(numout,*)
847         WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
848         WRITE(numout,*) '~~~~~~~~~~~~~~~'
849         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
850         WRITE(numout,*) '      Two way nesting activated ln_agrif_2way         = ', ln_agrif_2way
851         WRITE(numout,*) '      child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar
852         WRITE(numout,*) '      ad. sponge coeft for tracers      rn_sponge_tra = ', rn_sponge_tra
853         WRITE(numout,*) '      ad. sponge coeft for dynamics     rn_sponge_tra = ', rn_sponge_dyn
854         WRITE(numout,*) '      ad. time relaxation for tracers   rn_trelax_tra = ', rn_trelax_tra
855         WRITE(numout,*) '      ad. time relaxation for dynamics  rn_trelax_dyn = ', rn_trelax_dyn
856         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
857         WRITE(numout,*) '      vertical remapping                ln_vert_remap = ', ln_vert_remap
858         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
859      ENDIF
860
861! JC => side effects of lines below to be checked:
862      lk_west  = .NOT. ( Agrif_Ix() == 1 )
863      lk_east  = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo) -1 )
864      lk_south = .NOT. ( Agrif_Iy() == 1 )
865      lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) -1 )
866      !
867      ! Set the number of ghost cells according to periodicity
868      nbghostcells_x   = nbghostcells
869      nbghostcells_y_s = nbghostcells
870      nbghostcells_y_n = nbghostcells
871      !
872      IF(   jperio == 1  )   nbghostcells_x   = 0
873      IF( .NOT. lk_south )   nbghostcells_y_s = 0
874      IF( .NOT. lk_north )   nbghostcells_y_n = 0
875      !
876      ! Some checks
877      IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x   + nbghostcells_x   )   CALL ctl_stop( 'STOP',    &
878         &   'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nn_hls + 2*nbghostcells_x' )
879      IF( jpjglo /= nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n )   CALL ctl_stop( 'STOP',    &
880         &   'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' )
881      IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' )
882      !
883      !
884   END SUBROUTINE agrif_nemo_init
885
886   
887# if defined key_mpp_mpi
888   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
889      !!----------------------------------------------------------------------
890      !!                     *** ROUTINE Agrif_InvLoc ***
891      !!----------------------------------------------------------------------
892      USE dom_oce
893      !!
894      IMPLICIT NONE
895      !
896      INTEGER :: indglob, indloc, nprocloc, i
897      !!----------------------------------------------------------------------
898      !
899      SELECT CASE( i )
900      CASE(1)        ;   indglob = mig(indloc)
901      CASE(2)        ;   indglob = mjg(indloc)
902      CASE DEFAULT   ;   indglob = indloc
903      END SELECT
904      !
905   END SUBROUTINE Agrif_InvLoc
906
907   
908   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
909      !!----------------------------------------------------------------------
910      !!                 *** ROUTINE Agrif_get_proc_info ***
911      !!----------------------------------------------------------------------
912      USE par_oce
913      !!
914      IMPLICIT NONE
915      !
916      INTEGER, INTENT(out) :: imin, imax
917      INTEGER, INTENT(out) :: jmin, jmax
918      !!----------------------------------------------------------------------
919      !
920      imin = mig( 1 )
921      jmin = mjg( 1 )
922      imax = mig(jpi)
923      jmax = mjg(jpj)
924      !
925   END SUBROUTINE Agrif_get_proc_info
926
927   
928   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
929      !!----------------------------------------------------------------------
930      !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
931      !!----------------------------------------------------------------------
932      USE par_oce
933      !!
934      IMPLICIT NONE
935      !
936      INTEGER,  INTENT(in)  :: imin, imax
937      INTEGER,  INTENT(in)  :: jmin, jmax
938      INTEGER,  INTENT(in)  :: nbprocs
939      REAL(wp), INTENT(out) :: grid_cost
940      !!----------------------------------------------------------------------
941      !
942      grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
943      !
944   END SUBROUTINE Agrif_estimate_parallel_cost
945
946# endif
947
948   SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks)
949      !!----------------------------------------------------------------------
950      !!                   *** ROUTINE Nemo_mapping ***
951      !!----------------------------------------------------------------------
952      USE dom_oce
953      !!
954      IMPLICIT NONE
955      !
956      INTEGER :: ndim
957      INTEGER :: ptx, pty
958      INTEGER, DIMENSION(ndim,2,2) :: bounds
959      INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks
960      LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required
961      INTEGER :: nb_chunks
962      !
963      INTEGER :: i
964
965      IF (agrif_debug_interp) THEN
966         DO i=1,ndim
967            WRITE(*,*) 'direction = ',i,bounds(i,1,2),bounds(i,2,2)
968         ENDDO
969      ENDIF
970
971      IF( bounds(2,2,2) > jpjglo) THEN
972         IF( bounds(2,1,2) <=jpjglo) THEN
973            nb_chunks = 2
974            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
975            ALLOCATE(correction_required(nb_chunks))
976            DO i = 1,nb_chunks
977               bounds_chunks(i,:,:,:) = bounds
978            END DO
979       
980      ! FIRST CHUNCK (for j<=jpjglo)   
981
982      ! Original indices
983            bounds_chunks(1,1,1,1) = bounds(1,1,2)
984            bounds_chunks(1,1,2,1) = bounds(1,2,2)
985            bounds_chunks(1,2,1,1) = bounds(2,1,2)
986            bounds_chunks(1,2,2,1) = jpjglo
987
988            bounds_chunks(1,1,1,2) = bounds(1,1,2)
989            bounds_chunks(1,1,2,2) = bounds(1,2,2)
990            bounds_chunks(1,2,1,2) = bounds(2,1,2)
991            bounds_chunks(1,2,2,2) = jpjglo
992
993      ! Correction required or not
994            correction_required(1)=.FALSE.
995       
996      ! SECOND CHUNCK (for j>jpjglo)
997
998      ! Original indices
999            bounds_chunks(2,1,1,1) = bounds(1,1,2)
1000            bounds_chunks(2,1,2,1) = bounds(1,2,2)
1001            bounds_chunks(2,2,1,1) = jpjglo-2
1002            bounds_chunks(2,2,2,1) = bounds(2,2,2)
1003
1004      ! Where to find them
1005      ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo))
1006
1007            IF( ptx == 2) THEN ! T, V points
1008               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2
1009               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2
1010            ELSE ! U, F points
1011               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1
1012               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1       
1013            ENDIF
1014
1015            IF( pty == 2) THEN ! T, U points
1016               bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo)
1017               bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2      -jpjglo)
1018            ELSE ! V, F points
1019               bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo)
1020               bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2      -jpjglo)
1021            ENDIF
1022      ! Correction required or not
1023            correction_required(2)=.TRUE.
1024
1025         ELSE
1026            nb_chunks = 1
1027            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1028            ALLOCATE(correction_required(nb_chunks))
1029            DO i=1,nb_chunks
1030               bounds_chunks(i,:,:,:) = bounds
1031            END DO
1032
1033            bounds_chunks(1,1,1,1) = bounds(1,1,2)
1034            bounds_chunks(1,1,2,1) = bounds(1,2,2)
1035            bounds_chunks(1,2,1,1) = bounds(2,1,2)
1036            bounds_chunks(1,2,2,1) = bounds(2,2,2)
1037
1038            bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2
1039            bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2
1040
1041            bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo)
1042            bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo)
1043
1044            IF( ptx == 2) THEN ! T, V points
1045               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2
1046               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2
1047            ELSE ! U, F points
1048               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1
1049               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1       
1050            ENDIF
1051
1052            IF (pty == 2) THEN ! T, U points
1053               bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo)
1054               bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo)
1055            ELSE ! V, F points
1056               bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo)
1057               bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo)
1058            ENDIF
1059
1060            correction_required(1)=.TRUE.         
1061         ENDIF
1062
1063      ELSE IF (bounds(1,1,2) < 1) THEN
1064         IF (bounds(1,2,2) > 0) THEN
1065            nb_chunks = 2
1066            ALLOCATE(correction_required(nb_chunks))
1067            correction_required=.FALSE.
1068            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1069            DO i=1,nb_chunks
1070               bounds_chunks(i,:,:,:) = bounds
1071            END DO
1072             
1073            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2
1074            bounds_chunks(1,1,2,2) = 1+jpiglo-2
1075         
1076            bounds_chunks(1,1,1,1) = bounds(1,1,2)
1077            bounds_chunks(1,1,2,1) = 1
1078       
1079            bounds_chunks(2,1,1,2) = 2
1080            bounds_chunks(2,1,2,2) = bounds(1,2,2)
1081         
1082            bounds_chunks(2,1,1,1) = 2
1083            bounds_chunks(2,1,2,1) = bounds(1,2,2)
1084
1085         ELSE
1086            nb_chunks = 1
1087            ALLOCATE(correction_required(nb_chunks))
1088            correction_required=.FALSE.
1089            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1090            DO i=1,nb_chunks
1091               bounds_chunks(i,:,:,:) = bounds
1092            END DO   
1093            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2
1094            bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2
1095         
1096            bounds_chunks(1,1,1,1) = bounds(1,1,2)
1097           bounds_chunks(1,1,2,1) = bounds(1,2,2)
1098         ENDIF
1099      ELSE
1100         nb_chunks=1 
1101         ALLOCATE(correction_required(nb_chunks))
1102         correction_required=.FALSE.
1103         ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1104         DO i=1,nb_chunks
1105            bounds_chunks(i,:,:,:) = bounds
1106         END DO
1107         bounds_chunks(1,1,1,2) = bounds(1,1,2)
1108         bounds_chunks(1,1,2,2) = bounds(1,2,2)
1109         bounds_chunks(1,2,1,2) = bounds(2,1,2)
1110         bounds_chunks(1,2,2,2) = bounds(2,2,2)
1111         
1112         bounds_chunks(1,1,1,1) = bounds(1,1,2)
1113         bounds_chunks(1,1,2,1) = bounds(1,2,2)
1114         bounds_chunks(1,2,1,1) = bounds(2,1,2)
1115         bounds_chunks(1,2,2,1) = bounds(2,2,2)             
1116      ENDIF
1117       
1118   END SUBROUTINE nemo_mapping
1119
1120   FUNCTION agrif_external_switch_index(ptx,pty,i1,isens)
1121
1122      USE dom_oce
1123      !
1124      IMPLICIT NONE
1125
1126      INTEGER :: ptx, pty, i1, isens
1127      INTEGER :: agrif_external_switch_index
1128      !!----------------------------------------------------------------------
1129
1130      IF( isens == 1 ) THEN
1131         IF( ptx == 2 ) THEN ! T, V points
1132            agrif_external_switch_index = jpiglo-i1+2
1133         ELSE ! U, F points
1134            agrif_external_switch_index = jpiglo-i1+1     
1135         ENDIF
1136      ELSE IF( isens ==2 ) THEN
1137         IF ( pty == 2 ) THEN ! T, U points
1138            agrif_external_switch_index = jpjglo-2-(i1 -jpjglo)
1139         ELSE ! V, F points
1140            agrif_external_switch_index = jpjglo-3-(i1 -jpjglo)
1141         ENDIF
1142      ENDIF
1143
1144   END FUNCTION agrif_external_switch_index
1145
1146   SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2)
1147      !!----------------------------------------------------------------------
1148      !!                   *** ROUTINE Correct_field ***
1149      !!----------------------------------------------------------------------
1150      USE dom_oce
1151      USE agrif_oce
1152      !
1153      IMPLICIT NONE
1154      !
1155      INTEGER :: i1,i2,j1,j2
1156      REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d
1157      !
1158      INTEGER :: i,j
1159      REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp
1160      !!----------------------------------------------------------------------
1161
1162      tab2dtemp = tab2d
1163
1164      IF( .NOT. use_sign_north ) THEN
1165         DO j=j1,j2
1166            DO i=i1,i2
1167               tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1))
1168            END DO
1169         END DO
1170      ELSE
1171         DO j=j1,j2
1172            DO i=i1,i2
1173               tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1))
1174            END DO
1175         END DO
1176      ENDIF
1177
1178   END SUBROUTINE Correct_field
1179
1180#else
1181   SUBROUTINE Subcalledbyagrif
1182      !!----------------------------------------------------------------------
1183      !!                   *** ROUTINE Subcalledbyagrif ***
1184      !!----------------------------------------------------------------------
1185      WRITE(*,*) 'Impossible to be here'
1186   END SUBROUTINE Subcalledbyagrif
1187#endif
Note: See TracBrowser for help on using the repository browser.