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_r12558_HPC-08_epico_Extra_Halo/src/NST – NEMO

source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_user.F90 @ 13130

Last change on this file since 13130 was 13130, checked in by smasson, 4 years ago

Extra_Halo: supress halos from outputs and coupling, see #2366

  • Property svn:keywords set to Id
File size: 39.3 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_nemo_init
31      CALL Agrif_InitValues_cont_dom
32      CALL Agrif_InitValues_cont
33# if defined key_top
34      CALL Agrif_InitValues_cont_top
35# endif
36# if defined key_si3
37      CALL Agrif_InitValues_cont_ice
38# endif
39      !   
40   END SUBROUTINE Agrif_initvalues
41
42   SUBROUTINE Agrif_InitValues_cont_dom
43      !!----------------------------------------------------------------------
44      !!                 *** ROUTINE Agrif_InitValues_cont_dom ***
45      !!----------------------------------------------------------------------
46      !
47      CALL agrif_declare_var_dom
48      !
49   END SUBROUTINE Agrif_InitValues_cont_dom
50
51   SUBROUTINE agrif_declare_var_dom
52      !!----------------------------------------------------------------------
53      !!                 *** ROUTINE agrif_declare_var_dom ***
54      !!----------------------------------------------------------------------
55      USE par_oce, ONLY:  nbghostcells     
56      !
57      IMPLICIT NONE
58      !
59      INTEGER :: ind1, ind2, ind3
60      !!----------------------------------------------------------------------
61
62      ! 1. Declaration of the type of variable which have to be interpolated
63      !---------------------------------------------------------------------
64      ind1 =          nbghostcells       ! do the interpolation over nbghostcells points
65      ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid
66      ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid
67      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
68      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
69
70      ! 2. Type of interpolation
71      !-------------------------
72      CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    )
73      CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear )
74
75      ! 3. Location of interpolation
76      !-----------------------------
77      CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
78      CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
79
80      ! 4. Update type
81      !---------------
82# if defined UPD_HIGH
83      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting)
84      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average)
85#else
86      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
87      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
88#endif
89
90   END SUBROUTINE agrif_declare_var_dom
91
92   SUBROUTINE Agrif_InitValues_cont
93      !!----------------------------------------------------------------------
94      !!                 *** ROUTINE Agrif_InitValues_cont ***
95      !!----------------------------------------------------------------------
96      USE agrif_oce
97      USE agrif_oce_interp
98      USE agrif_oce_sponge
99      USE dom_oce
100      USE oce
101      USE lib_mpp
102      USE lbclnk
103      !
104      IMPLICIT NONE
105      !
106      INTEGER :: ji, jj
107      LOGICAL :: check_namelist
108      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 
109#if defined key_vertical
110      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace
111#endif
112      !!----------------------------------------------------------------------
113
114      ! 1. Declaration of the type of variable which have to be interpolated
115      !---------------------------------------------------------------------
116      CALL agrif_declare_var
117
118      ! 2. First interpolations of potentially non zero fields
119      !-------------------------------------------------------
120
121#if defined key_vertical
122      ! Build consistent parent bathymetry and number of levels
123      ! on the child grid
124      Agrif_UseSpecialValue = .FALSE.
125      ht0_parent(:,:) = 0._wp
126      mbkt_parent(:,:) = 0
127      !
128      CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
129      CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
130      !
131      ! Assume step wise change of bathymetry near interface
132      ! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case
133      !       and no refinement
134      DO_2D_10_10
135         mbku_parent(ji,jj) = MIN(  mbkt_parent(ji+1,jj  ) , mbkt_parent(ji,jj)  )
136         mbkv_parent(ji,jj) = MIN(  mbkt_parent(ji  ,jj+1) , mbkt_parent(ji,jj)  )
137      END_2D
138      IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN
139         DO_2D_10_10
140            hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) )
141            hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) )
142         END_2D
143      ELSE
144         DO_2D_10_10
145            hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj))
146            hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1))
147         END_2D
148
149      ENDIF
150      !
151      CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. )
152      CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. )
153      zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. )
154      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
155      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. )
156      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )   
157#endif
158
159      Agrif_SpecialValue    = 0._wp
160      Agrif_UseSpecialValue = .TRUE.
161      CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
162      CALL Agrif_Sponge
163      tabspongedone_tsn = .FALSE.
164      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
165      ! reset ts(:,:,:,:,Krhs_a) to zero
166      ts(:,:,:,:,Krhs_a) = 0._wp
167
168      Agrif_UseSpecialValue = ln_spc_dyn
169      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
170      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
171      tabspongedone_u = .FALSE.
172      tabspongedone_v = .FALSE.
173      CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
174      tabspongedone_u = .FALSE.
175      tabspongedone_v = .FALSE.
176      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
177      uu(:,:,:,Krhs_a) = 0._wp
178      vv(:,:,:,Krhs_a) = 0._wp
179
180      Agrif_UseSpecialValue = .TRUE.
181      CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
182      hbdy(:,:) = 0._wp
183      ssh(:,:,Krhs_a) = 0._wp
184
185      IF ( ln_dynspg_ts ) THEN
186         Agrif_UseSpecialValue = ln_spc_dyn
187         CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
188         CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
189         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
190         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
191         ubdy(:,:) = 0._wp
192         vbdy(:,:) = 0._wp
193      ENDIF
194
195      Agrif_UseSpecialValue = .FALSE.
196
197      ! 3. Some controls
198      !-----------------
199      check_namelist = .TRUE.
200
201      IF( check_namelist ) THEN 
202
203         ! Check time steps           
204         IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN
205            WRITE(cl_check1,*)  NINT(Agrif_Parent(rn_Dt))
206            WRITE(cl_check2,*)  NINT(rn_Dt)
207            WRITE(cl_check3,*)  NINT(Agrif_Parent(rn_Dt)/Agrif_Rhot())
208            CALL ctl_stop( 'Incompatible time step between ocean grids',   &
209                  &               'parent grid value : '//cl_check1    ,   & 
210                  &               'child  grid value : '//cl_check2    ,   & 
211                  &               'value on child grid should be changed to : '//cl_check3 )
212         ENDIF
213
214         ! Check run length
215         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
216               Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
217            WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
218            WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
219            CALL ctl_warn( 'Incompatible run length between grids'                      ,   &
220                  &               'nit000 on fine grid will be changed to : '//cl_check1,   &
221                  &               'nitend on fine grid will be changed to : '//cl_check2    )
222            nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
223            nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
224         ENDIF
225
226         ! Check free surface scheme
227         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
228            & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
229            WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts )
230            WRITE(cl_check2,*)  ln_dynspg_ts
231            WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp )
232            WRITE(cl_check4,*)  ln_dynspg_exp
233            CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  &
234                  &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  & 
235                  &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  &
236                  &               'parent grid ln_dynspg_exp :'//cl_check3  ,  &
237                  &               'child  grid ln_dynspg_exp :'//cl_check4  ,  &
238                  &               'those logicals should be identical' )                 
239            STOP
240         ENDIF
241
242         ! Check if identical linear free surface option
243         IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
244            & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
245            WRITE(cl_check1,*)  Agrif_Parent(ln_linssh )
246            WRITE(cl_check2,*)  ln_linssh
247            CALL ctl_stop( 'Incompatible linearized fs option between grids',  &
248                  &               'parent grid ln_linssh  :'//cl_check1     ,  &
249                  &               'child  grid ln_linssh  :'//cl_check2     ,  &
250                  &               'those logicals should be identical' )                 
251            STOP
252         ENDIF
253
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 ! defined key_vertical
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         DO_2D_00_00
273            IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
274            IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
275            IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
276         END_2D
277# endif
278         CALL mpp_sum( 'agrif_user', kindic_agr )
279         IF( kindic_agr /= 0 ) THEN
280            CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
281         ELSE
282            IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'
283            IF(lwp) WRITE(numout,*) ' '
284         END IF 
285         !   
286!!$         IF(lwp) WRITE(numout,*) ' '
287!!$         IF(lwp) WRITE(numout,*) 'AGRIF: Check longitude and latitude near bdys. Level: ', Agrif_Level()
288!!$         !
289!!$         ! check glamt in sponge area:
290!!$         kindic_agr = 0
291!!$         CALL Agrif_Bc_variable(glamt_id,calledweight=1.,procname=interpglamt)
292!!$         CALL mpp_sum( 'agrif_user', kindic_agr )
293!!$         IF( kindic_agr /= 0 ) THEN
294!!$            CALL ctl_stop('==> Child glamt is NOT correct near boundaries.')1
295!!$         ELSE
296!!$            IF(lwp) WRITE(numout,*) '==> Child glamt is ok near boundaries.'
297!!$            IF(lwp) WRITE(numout,*) ' '
298!!$         END IF 
299!!$         !
300!!$         ! check gphit in sponge area:
301!!$         kindic_agr = 0
302!!$         CALL Agrif_Bc_variable(gphit_id,calledweight=1.,procname=interpgphit)
303!!$         CALL mpp_sum( 'agrif_user', kindic_agr )
304!!$         IF( kindic_agr /= 0 ) THEN
305!!$            CALL ctl_stop('==> Child gphit is NOT correct near boundaries.')
306!!$         ELSE
307!!$            IF(lwp) WRITE(numout,*) '==> Child gphit is ok near boundaries.'
308!!$            IF(lwp) WRITE(numout,*) ' '
309!!$         END IF 
310         !
311      ENDIF
312
313# if defined key_vertical
314      ! Additional constrain that should be removed someday:
315      IF ( Agrif_Parent(jpk).GT.jpk ) THEN
316    CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' )
317      ENDIF
318# endif
319      !
320   END SUBROUTINE Agrif_InitValues_cont
321
322   SUBROUTINE agrif_declare_var
323      !!----------------------------------------------------------------------
324      !!                 *** ROUTINE agrif_declare_var ***
325      !!----------------------------------------------------------------------
326      USE agrif_util
327      USE agrif_oce
328      USE par_oce
329      USE zdf_oce 
330      USE oce
331      !
332      IMPLICIT NONE
333      !
334      INTEGER :: ind1, ind2, ind3
335      !!----------------------------------------------------------------------
336
337      ! 1. Declaration of the type of variable which have to be interpolated
338      !---------------------------------------------------------------------
339      ind1 =          nbghostcells       ! do the interpolation over nbghostcells points
340      ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid
341      ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid
342# if defined key_vertical
343      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id)
344      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id)
345
346      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id)
347      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id)
348      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id)
349      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id)
350      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id)
351      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id)
352# else
353      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id)
354      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id)
355
356      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id)
357      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id)
358      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id)
359      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id)
360      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id)
361      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id)
362# endif
363
364      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id)
365      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id)
366      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id)
367
368# if defined key_vertical
369      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id)
370      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id)
371# endif
372
373      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,3/),scales_t_id)
374
375      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id)
376      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id)
377      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id)
378      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id)
379      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id)
380      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id)
381
382      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
383
384      IF( ln_zdftke.OR.ln_zdfgls ) THEN
385!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
386!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
387# if defined key_vertical
388         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id)
389# else
390         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id)
391# endif
392      ENDIF
393
394      ! 2. Type of interpolation
395      !-------------------------
396      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
397
398      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
399      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
400
401      CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
402
403      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
404      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
405      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
406      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
407      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
408!
409! > Divergence conserving alternative:
410!      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
411!      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant)
412!      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear)
413!      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant)
414!      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear)
415!<
416
417      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
418      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
419
420      CALL Agrif_Set_bcinterp(  e3t_id,interp=AGRIF_constant)
421      CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant)
422      CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant)
423
424# if defined key_vertical
425      CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant)
426      CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant)
427# endif
428
429      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
430
431      ! 3. Location of interpolation
432      !-----------------------------
433      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4
434      CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) ) 
435      CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
436
437      CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! if west,  rhox=3, nn_sponge_len=2
438      CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! and nbghost=3:
439      CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! columns 4 to 11
440
441      CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) )
442      CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) )
443      CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) )
444      CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
445      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
446
447!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) 
448! JC: check near the boundary only until matching in sponge has been sorted out:
449      CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) ) 
450      CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) ) 
451      CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) ) 
452
453# if defined key_vertical 
454      ! extend the interpolation zone by 1 more point than necessary:
455      CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
456      CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
457# endif
458
459      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
460
461      ! 4. Update type
462      !---------------
463      CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
464
465# if defined UPD_HIGH
466      CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
467      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
468      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
469
470      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
471      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
472      CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting)
473      CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
474
475      IF( ln_zdftke.OR.ln_zdfgls ) THEN
476!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
477!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
478!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
479      ENDIF
480
481#else
482      CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
483      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
484      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
485
486      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
487      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
488      CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average)
489      CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
490
491      IF( ln_zdftke.OR.ln_zdfgls ) THEN
492!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
493!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
494!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
495      ENDIF
496
497#endif
498      !
499   END SUBROUTINE agrif_declare_var
500
501#if defined key_si3
502SUBROUTINE Agrif_InitValues_cont_ice
503      !!----------------------------------------------------------------------
504      !!                 *** ROUTINE Agrif_InitValues_cont_ice ***
505      !!----------------------------------------------------------------------
506      USE Agrif_Util
507      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
508      USE ice
509      USE agrif_ice
510      USE in_out_manager
511      USE agrif_ice_interp
512      USE lib_mpp
513      !
514      IMPLICIT NONE
515      !!----------------------------------------------------------------------
516      !
517      ! Declaration of the type of variable which have to be interpolated (parent=>child)
518      !----------------------------------------------------------------------------------
519      CALL agrif_declare_var_ice
520
521      ! Controls
522
523      ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
524      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
525      !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
526      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
527      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
528
529      ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
530      IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
531         CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
532      ENDIF
533      ! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
534      !----------------------------------------------------------------------
535      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)
536      CALL agrif_interp_ice('U') ! interpolation of ice velocities
537      CALL agrif_interp_ice('V') ! interpolation of ice velocities
538      CALL agrif_interp_ice('T') ! interpolation of ice tracers
539      nbstep_ice = 0   
540      !
541   END SUBROUTINE Agrif_InitValues_cont_ice
542
543   SUBROUTINE agrif_declare_var_ice
544      !!----------------------------------------------------------------------
545      !!                 *** ROUTINE agrif_declare_var_ice ***
546      !!----------------------------------------------------------------------
547      USE Agrif_Util
548      USE ice
549      USE par_oce, ONLY : nbghostcells
550      !
551      IMPLICIT NONE
552      !
553      INTEGER :: ind1, ind2, ind3
554      !!----------------------------------------------------------------------
555      !
556      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
557      !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
558      !           ex.:  position=> 1,1 = not-centered (in i and j)
559      !                            2,2 =     centered (    -     )
560      !                 index   => 1,1 = one ghost line
561      !                            2,2 = two ghost lines
562      !-------------------------------------------------------------------------------------
563      ind1 =          nbghostcells       ! do the interpolation over nbghostcells points
564      ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid
565      ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid
566      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id)
567      CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,u_ice_id  )
568      CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,v_ice_id  )
569
570      ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
571      !-----------------------------------
572      CALL Agrif_Set_bcinterp(tra_ice_id, interp  = AGRIF_linear)
573      CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
574      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
575
576      ! 3. Set location of interpolations
577      !----------------------------------
578      CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
579      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
580      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
581
582      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
583      !--------------------------------------------------
584# if defined UPD_HIGH
585      CALL Agrif_Set_Updatetype(tra_ice_id, update  = Agrif_Update_Full_Weighting)
586      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
587      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
588#else
589      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average)
590      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
591      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
592#endif
593
594   END SUBROUTINE agrif_declare_var_ice
595#endif
596
597
598# if defined key_top
599   SUBROUTINE Agrif_InitValues_cont_top
600      !!----------------------------------------------------------------------
601      !!                 *** ROUTINE Agrif_InitValues_cont_top ***
602      !!----------------------------------------------------------------------
603      USE Agrif_Util
604      USE oce 
605      USE dom_oce
606      USE nemogcm
607      USE par_trc
608      USE lib_mpp
609      USE trc
610      USE in_out_manager
611      USE agrif_oce_sponge
612      USE agrif_top_update
613      USE agrif_top_interp
614      USE agrif_top_sponge
615      !!
616      IMPLICIT NONE
617      !
618      CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
619      LOGICAL :: check_namelist
620      !!----------------------------------------------------------------------
621
622      ! 1. Declaration of the type of variable which have to be interpolated
623      !---------------------------------------------------------------------
624      CALL agrif_declare_var_top
625
626      ! 2. First interpolations of potentially non zero fields
627      !-------------------------------------------------------
628      Agrif_SpecialValue=0._wp
629      Agrif_UseSpecialValue = .TRUE.
630      CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
631      Agrif_UseSpecialValue = .FALSE.
632      CALL Agrif_Sponge
633      tabspongedone_trn = .FALSE.
634      CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
635      ! reset ts(:,:,:,:,Krhs_a) to zero
636      tr(:,:,:,:,Krhs_a) = 0._wp
637
638      ! 3. Some controls
639      !-----------------
640      check_namelist = .TRUE.
641
642      IF( check_namelist ) THEN
643         ! Check time steps
644      IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN
645         WRITE(cl_check1,*)  Agrif_Parent(rn_Dt)
646         WRITE(cl_check2,*)  rn_Dt
647         WRITE(cl_check3,*)  rn_Dt*Agrif_Rhot()
648         CALL ctl_stop( 'incompatible time step between grids',   &
649               &               'parent grid value : '//cl_check1    ,   & 
650               &               'child  grid value : '//cl_check2    ,   & 
651               &               'value on child grid should be changed to  &
652               &               :'//cl_check3  )
653      ENDIF
654
655      ! Check run length
656      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
657            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
658         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
659         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
660         CALL ctl_warn( 'incompatible run length between grids'               ,   &
661               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
662               &              ' nitend on fine grid will be change to : '//cl_check2    )
663         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
664         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
665      ENDIF
666
667   ENDIF
668   !
669   END SUBROUTINE Agrif_InitValues_cont_top
670
671
672   SUBROUTINE agrif_declare_var_top
673      !!----------------------------------------------------------------------
674      !!                 *** ROUTINE agrif_declare_var_top ***
675      !!----------------------------------------------------------------------
676      USE agrif_util
677      USE agrif_oce
678      USE dom_oce
679      USE trc
680      !!
681      IMPLICIT NONE
682      !
683      INTEGER :: ind1, ind2, ind3
684      !!----------------------------------------------------------------------
685
686      ! 1. Declaration of the type of variable which have to be interpolated
687      !---------------------------------------------------------------------
688      ind1 =          nbghostcells       ! do the interpolation over nbghostcells points
689      ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid
690      ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid
691# if defined key_vertical
692      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id)
693      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id)
694# else
695      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id)
696      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id)
697# endif
698
699      ! 2. Type of interpolation
700      !-------------------------
701      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
702      CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
703
704      ! 3. Location of interpolation
705      !-----------------------------
706      CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
707      CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
708
709      ! 4. Update type
710      !---------------
711# if defined UPD_HIGH
712      CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
713#else
714      CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
715#endif
716   !
717   END SUBROUTINE agrif_declare_var_top
718# endif
719
720   SUBROUTINE Agrif_detect( kg, ksizex )
721      !!----------------------------------------------------------------------
722      !!                      *** ROUTINE Agrif_detect ***
723      !!----------------------------------------------------------------------
724      INTEGER, DIMENSION(2) :: ksizex
725      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
726      !!----------------------------------------------------------------------
727      !
728      RETURN
729      !
730   END SUBROUTINE Agrif_detect
731
732   SUBROUTINE agrif_nemo_init
733      !!----------------------------------------------------------------------
734      !!                     *** ROUTINE agrif_init ***
735      !!----------------------------------------------------------------------
736      USE agrif_oce 
737      USE agrif_ice
738      USE in_out_manager
739      USE lib_mpp
740      !!
741      IMPLICIT NONE
742      !
743      INTEGER  ::   ios                 ! Local integer output status for namelist read
744      NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
745                       & ln_spc_dyn, ln_chk_bathy
746      !!--------------------------------------------------------------------------------------
747      !
748      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
749901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist' )
750      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
751902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
752      IF(lwm) WRITE ( numond, namagrif )
753      !
754      IF(lwp) THEN                    ! control print
755         WRITE(numout,*)
756         WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
757         WRITE(numout,*) '~~~~~~~~~~~~~~~'
758         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
759         WRITE(numout,*) '      Two way nesting activated ln_agrif_2way         = ', ln_agrif_2way
760         WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' m^2/s'
761         WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s'
762         WRITE(numout,*) '      time relaxation for tracers       rn_trelax_tra = ', rn_trelax_tra, ' ad.'
763         WRITE(numout,*) '      time relaxation for dynamics      rn_trelax_dyn = ', rn_trelax_dyn, ' ad.'
764         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
765         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
766      ENDIF
767      !
768      !
769      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
770      !
771   END SUBROUTINE agrif_nemo_init
772
773# if defined key_mpp_mpi
774
775   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
776      !!----------------------------------------------------------------------
777      !!                     *** ROUTINE Agrif_InvLoc ***
778      !!----------------------------------------------------------------------
779      USE dom_oce
780      !!
781      IMPLICIT NONE
782      !
783      INTEGER :: indglob, indloc, nprocloc, i
784      !!----------------------------------------------------------------------
785      !
786      SELECT CASE( i )
787      CASE(1)        ;   indglob = mig(indloc)
788      CASE(2)        ;   indglob = mjg(indloc)
789      CASE DEFAULT   ;   indglob = indloc
790      END SELECT
791      !
792   END SUBROUTINE Agrif_InvLoc
793
794   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
795      !!----------------------------------------------------------------------
796      !!                 *** ROUTINE Agrif_get_proc_info ***
797      !!----------------------------------------------------------------------
798      USE par_oce
799      !!
800      IMPLICIT NONE
801      !
802      INTEGER, INTENT(out) :: imin, imax
803      INTEGER, INTENT(out) :: jmin, jmax
804      !!----------------------------------------------------------------------
805      !
806      imin = mig( 1 )
807      jmin = mjg( 1 )
808      imax = mig(jpi)
809      jmax = mjg(jpj)
810      !
811   END SUBROUTINE Agrif_get_proc_info
812
813   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
814      !!----------------------------------------------------------------------
815      !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
816      !!----------------------------------------------------------------------
817      USE par_oce
818      !!
819      IMPLICIT NONE
820      !
821      INTEGER,  INTENT(in)  :: imin, imax
822      INTEGER,  INTENT(in)  :: jmin, jmax
823      INTEGER,  INTENT(in)  :: nbprocs
824      REAL(wp), INTENT(out) :: grid_cost
825      !!----------------------------------------------------------------------
826      !
827      grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
828      !
829   END SUBROUTINE Agrif_estimate_parallel_cost
830
831# endif
832
833#else
834   SUBROUTINE Subcalledbyagrif
835      !!----------------------------------------------------------------------
836      !!                   *** ROUTINE Subcalledbyagrif ***
837      !!----------------------------------------------------------------------
838      WRITE(*,*) 'Impossible to be here'
839   END SUBROUTINE Subcalledbyagrif
840#endif
Note: See TracBrowser for help on using the repository browser.