source: NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/NST/agrif_user.F90 @ 13141

Last change on this file since 13141 was 13141, checked in by jchanut, 3 months ago

#2129, corrections/add ons to initial state interpolation with AGRIF
1) add namelist flag for child grid initial state interpolation - ice not considered yet
2) provide depths and not thicknesses as inputs to vertical linear interpolation
3) extend initial state interpolation to a restart scenario for parent grid (warning should be added in that case in order to prevent users doing this at each model restart…)
The online interpolation seems to work fine in the VORTEX case (provided 0. is not considered as a special value in the initial velocity field, i.e. ln_spc_dyn=F)

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