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 branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 9116

Last change on this file since 9116 was 9116, checked in by jchanut, 6 years ago

Finalize AGRIF ghost cells implementation: ensure compatibility with bdy smoothing or extrapolation
  • Property svn:keywords set to Id
File size: 36.4 KB
Line 
1#undef UPD_HIGH   /* MIX HIGH UPDATE */
2#if defined key_agrif
3!!----------------------------------------------------------------------
4!! NEMO/NST 4.0 , NEMO Consortium (2017)
5!! $Id$
6!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
7!!----------------------------------------------------------------------
8SUBROUTINE agrif_user
9END SUBROUTINE agrif_user
10
11SUBROUTINE agrif_before_regridding
12END SUBROUTINE agrif_before_regridding
13
14SUBROUTINE Agrif_InitWorkspace
15   !!----------------------------------------------------------------------
16   !!                 *** ROUTINE Agrif_InitWorkspace ***
17   !!----------------------------------------------------------------------
18   USE par_oce
19   USE dom_oce
20   USE nemogcm
21   !!
22   IMPLICIT NONE
23   !!----------------------------------------------------------------------
24   !
25   IF( .NOT. Agrif_Root() ) THEN
26      jpni = Agrif_Parent(jpni)
27      jpnj = Agrif_Parent(jpnj)
28      jpnij = Agrif_Parent(jpnij)
29      jpiglo  = nbcellsx + 2 + 2*nbghostcells
30      jpjglo  = nbcellsy + 2 + 2*nbghostcells
31      jpi     = ( jpiglo-2*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls
32      jpj     = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls
33! JC: change to allow for different vertical levels
34!     jpk is already set
35!     keep it jpk possibly different from jpkglo which
36!     hold parent grid vertical levels number (set earlier)
37!      jpk     = jpkglo
38      jpim1   = jpi-1 
39      jpjm1   = jpj-1 
40      jpkm1   = MAX( 1, jpk-1 )                                         
41      jpij    = jpi*jpj 
42      nperio  = 0
43      jperio  = 0
44   ENDIF
45   !
46END SUBROUTINE Agrif_InitWorkspace
47
48
49SUBROUTINE Agrif_InitValues
50   !!----------------------------------------------------------------------
51   !!                 *** ROUTINE Agrif_InitValues ***
52   !!
53   !! ** Purpose :: Declaration of variables to be interpolated
54   !!----------------------------------------------------------------------
55   USE Agrif_Util
56   USE oce 
57   USE dom_oce
58   USE nemogcm
59   USE tradmp
60   USE bdy_oce   , ONLY: ln_bdy
61   !!
62   IMPLICIT NONE
63   !!----------------------------------------------------------------------
64   !
65!!gm  I think this is now useless ...   nn_cfg & cn_cfg are set to -999999 and "UNKNOWN"
66!!gm                                    when reading the AGRIF domain configuration file
67   IF( cn_cfg == 'orca' ) THEN
68      IF ( nn_cfg == 2 .OR. nn_cfg == 025 .OR. nn_cfg == 05  .OR. nn_cfg == 4 ) THEN
69         nn_cfg = -1    ! set special value for nn_cfg on fine grids
70         cn_cfg = "default"
71      ENDIF
72   ENDIF
73   !                    !* Specific fine grid Initializations
74   ln_tradmp = .FALSE.        ! no tracer damping on fine grids
75   !
76   ln_bdy    = .FALSE.        ! no open boundary on fine grids
77
78   CALL nemo_init       !* Initializations of each fine grid
79
80   !                    !* Agrif initialization
81   CALL agrif_nemo_init
82   CALL Agrif_InitValues_cont_dom
83   CALL Agrif_InitValues_cont
84# if defined key_top
85   CALL Agrif_InitValues_cont_top
86# endif
87# if defined key_lim3
88   CALL Agrif_InitValues_cont_lim3
89# endif
90   !
91   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) CALL agrif_Update_ini()
92
93   Agrif_UseSpecialValueInUpdate = .FALSE.     
94
95END SUBROUTINE Agrif_initvalues
96
97
98SUBROUTINE Agrif_InitValues_cont_dom
99   !!----------------------------------------------------------------------
100   !!                 *** ROUTINE Agrif_InitValues_cont ***
101   !!
102   !! ** Purpose ::   Declaration of variables to be interpolated
103   !!----------------------------------------------------------------------
104   USE Agrif_Util
105   USE oce 
106   USE dom_oce
107   USE nemogcm
108   USE in_out_manager
109   USE agrif_opa_update
110   USE agrif_opa_interp
111   USE agrif_opa_sponge
112   !
113   IMPLICIT NONE
114   !!----------------------------------------------------------------------
115   !
116   ! Declaration of the type of variable which have to be interpolated
117   !
118   CALL agrif_declare_var_dom
119   !
120END SUBROUTINE Agrif_InitValues_cont_dom
121
122
123SUBROUTINE agrif_declare_var_dom
124   !!----------------------------------------------------------------------
125   !!                 *** ROUTINE agrif_declare_var ***
126   !!
127   !! ** Purpose :: Declaration of variables to be interpolated
128   !!----------------------------------------------------------------------
129   USE agrif_util
130   USE par_oce       
131   USE oce
132   !
133   IMPLICIT NONE
134   !
135   INTEGER :: ind1, ind2, ind3
136   !!----------------------------------------------------------------------
137
138   ! 1. Declaration of the type of variable which have to be interpolated
139   !---------------------------------------------------------------------
140   ind1 =     nbghostcells
141   ind2 = 1 + nbghostcells
142   ind3 = 2 + nbghostcells
143   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
144   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
145
146   ! 2. Type of interpolation
147   !-------------------------
148   CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    )
149   CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear )
150
151   ! 3. Location of interpolation
152   !-----------------------------
153   CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
154   CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
155
156   ! 4. Update type
157   !---------------
158# if defined UPD_HIGH
159   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting)
160   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average)
161#else
162   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
163   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
164#endif
165
166END SUBROUTINE agrif_declare_var_dom
167
168
169SUBROUTINE Agrif_InitValues_cont
170   !!----------------------------------------------------------------------
171   !!                 *** ROUTINE Agrif_InitValues_cont ***
172   !!
173   !! ** Purpose ::   Declaration of variables to be interpolated
174   !!----------------------------------------------------------------------
175   USE agrif_opa_update
176   USE agrif_opa_interp
177   USE agrif_opa_sponge
178   USE Agrif_Util
179   USE oce 
180   USE dom_oce
181   USE zdf_oce
182   USE nemogcm
183   !
184   USE lib_mpp
185   USE in_out_manager
186   !
187   IMPLICIT NONE
188   !
189   LOGICAL :: check_namelist
190   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 
191   !!----------------------------------------------------------------------
192
193   ! 1. Declaration of the type of variable which have to be interpolated
194   !---------------------------------------------------------------------
195   CALL agrif_declare_var
196
197   ! 2. First interpolations of potentially non zero fields
198   !-------------------------------------------------------
199   Agrif_SpecialValue    = 0._wp
200   Agrif_UseSpecialValue = .TRUE.
201   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
202   CALL Agrif_Sponge
203   tabspongedone_tsn = .FALSE.
204   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
205   ! reset tsa to zero
206   tsa(:,:,:,:) = 0.
207
208   Agrif_UseSpecialValue = ln_spc_dyn
209   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
210   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
211   tabspongedone_u = .FALSE.
212   tabspongedone_v = .FALSE.
213   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
214   tabspongedone_u = .FALSE.
215   tabspongedone_v = .FALSE.
216   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
217
218   Agrif_UseSpecialValue = .TRUE.
219   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
220   hbdy_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 0.e0
221   ssha(:,:) = 0.e0
222
223   IF ( ln_dynspg_ts ) THEN
224      Agrif_UseSpecialValue = ln_spc_dyn
225      CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
226      CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
227      CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
228      CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
229      ubdy_w(:,:) = 0.e0 ; vbdy_w(:,:) = 0.e0
230      ubdy_e(:,:) = 0.e0 ; vbdy_e(:,:) = 0.e0
231      ubdy_n(:,:) = 0.e0 ; vbdy_n(:,:) = 0.e0
232      ubdy_s(:,:) = 0.e0 ; vbdy_s(:,:) = 0.e0
233   ENDIF
234
235   Agrif_UseSpecialValue = .FALSE. 
236   ! reset velocities to zero
237   ua(:,:,:) = 0.
238   va(:,:,:) = 0.
239
240   ! 3. Some controls
241   !-----------------
242   check_namelist = .TRUE.
243
244   IF( check_namelist ) THEN 
245
246      ! Check time steps           
247      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
248         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
249         WRITE(cl_check2,*)  NINT(rdt)
250         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
251         CALL ctl_stop( 'Incompatible time step between ocean grids',   &
252               &               'parent grid value : '//cl_check1    ,   & 
253               &               'child  grid value : '//cl_check2    ,   & 
254               &               'value on child grid should be changed to : '//cl_check3 )
255      ENDIF
256
257      ! Check run length
258      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
259            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
260         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
261         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
262         CALL ctl_warn( 'Incompatible run length between grids'                      ,   &
263               &               'nit000 on fine grid will be changed to : '//cl_check1,   &
264               &               'nitend on fine grid will be changed to : '//cl_check2    )
265         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
266         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
267      ENDIF
268
269      ! Check free surface scheme
270      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
271         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
272         WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts )
273         WRITE(cl_check2,*)  ln_dynspg_ts
274         WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp )
275         WRITE(cl_check4,*)  ln_dynspg_exp
276         CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  &
277               &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  & 
278               &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  &
279               &               'parent grid ln_dynspg_exp :'//cl_check3  ,  &
280               &               'child  grid ln_dynspg_exp :'//cl_check4  ,  &
281               &               'those logicals should be identical' )                 
282         STOP
283      ENDIF
284
285      ! Check if identical linear free surface option
286      IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
287         & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
288         WRITE(cl_check1,*)  Agrif_Parent(ln_linssh )
289         WRITE(cl_check2,*)  ln_linssh
290         CALL ctl_stop( 'Incompatible linearized fs option between grids',  &
291               &               'parent grid ln_linssh  :'//cl_check1     ,  &
292               &               'child  grid ln_linssh  :'//cl_check2     ,  &
293               &               'those logicals should be identical' )                 
294         STOP
295      ENDIF
296
297      ! check if masks and bathymetries match
298      IF(ln_chk_bathy) THEN
299         !
300         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
301         !
302         kindic_agr = 0
303         ! check if umask agree with parent along western and eastern boundaries:
304         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
305         ! check if vmask agree with parent along northern and southern boundaries:
306         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
307         ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
308         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
309         !
310         IF (lk_mpp) CALL mpp_sum( kindic_agr )
311         IF( kindic_agr /= 0 ) THEN
312            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
313         ELSE
314            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
315         END IF
316      ENDIF
317      !
318   ENDIF
319   !
320END SUBROUTINE Agrif_InitValues_cont
321
322RECURSIVE SUBROUTINE Agrif_Update_ini( )
323   !!----------------------------------------------------------------------
324   !!                 *** ROUTINE agrif_Update_ini ***
325   !!
326   !! ** Purpose :: Recursive update done at initialization
327   !!----------------------------------------------------------------------
328   USE dom_oce
329   USE agrif_opa_update
330#if defined key_top
331   USE agrif_top_update
332#endif
333   !
334   IMPLICIT NONE
335   !!----------------------------------------------------------------------
336   !
337   IF (Agrif_Root()) RETURN
338   !
339   CALL Agrif_Update_ssh()
340   IF (.NOT.ln_linssh) CALL Agrif_Update_vvl()
341   CALL Agrif_Update_tra()
342#if defined key_top
343   CALL Agrif_Update_Trc()
344#endif
345   CALL Agrif_Update_dyn()
346! JC remove update because this precludes from perfect restartability
347!!   CALL Agrif_Update_tke(0)
348
349   CALL Agrif_ChildGrid_To_ParentGrid()
350   CALL Agrif_Update_ini()
351   CALL Agrif_ParentGrid_To_ChildGrid()
352
353END SUBROUTINE agrif_update_ini
354
355SUBROUTINE agrif_declare_var
356   !!----------------------------------------------------------------------
357   !!                 *** ROUTINE agrif_declarE_var ***
358   !!
359   !! ** Purpose :: Declaration of variables to be interpolated
360   !!----------------------------------------------------------------------
361   USE agrif_util
362   USE agrif_oce
363   USE par_oce       ! ocean parameters
364   USE zdf_oce       ! vertical physics
365   USE oce
366   !
367   IMPLICIT NONE
368   !
369   INTEGER :: ind1, ind2, ind3
370   !!----------------------------------------------------------------------
371
372   ! 1. Declaration of the type of variable which have to be interpolated
373   !---------------------------------------------------------------------
374   ind1 =     nbghostcells
375   ind2 = 1 + nbghostcells
376   ind3 = 2 + nbghostcells
377# if defined key_vertical
378   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id)
379   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id)
380
381   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id)
382   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id)
383   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id)
384   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id)
385   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id)
386   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id)
387# else
388   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
389   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
390
391   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id)
392   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id)
393   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id)
394   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id)
395   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id)
396   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id)
397# endif
398
399   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
400   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
401   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
402
403   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
404
405   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
406   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
407   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
408   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
409   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
410   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
411
412   CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
413
414   IF( ln_zdftke.OR.ln_zdfgls ) THEN
415!      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
416!      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
417# if defined key_vertical
418      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)
419# else
420      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id)
421# endif
422   ENDIF
423
424   ! 2. Type of interpolation
425   !-------------------------
426   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
427
428   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
429   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
430
431   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
432
433   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
434   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
435   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
436   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
437   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
438
439
440   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
441   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
442
443   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
444   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
445   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
446
447   IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
448
449   ! 3. Location of interpolation
450   !-----------------------------
451   CALL Agrif_Set_bc(       tsn_id, (/0,ind1/) )
452   CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) )
453   CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) )
454
455   CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9
456   CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
457   CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
458
459   CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) )
460   CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) )
461   CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) )
462   CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
463   CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
464
465   CALL Agrif_Set_bc(  e3t_id, (/-2*Agrif_irhox()-1,ind1-1/) )   ! if west and rhox=3 and ghost=1: column 2 to 9
466   CALL Agrif_Set_bc( umsk_id, (/0,ind1-1/)                  )
467   CALL Agrif_Set_bc( vmsk_id, (/0,ind1-1/)                  )
468
469   IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
470
471   ! 4. Update type
472   !---------------
473   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
474
475# if defined UPD_HIGH
476   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
477   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
478   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
479
480   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
481   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
482   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
483   CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
484
485   IF( ln_zdftke.OR.ln_zdfgls ) THEN
486!      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
487!      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
488!      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
489   ENDIF
490
491#else
492   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
493   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
494   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
495
496   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
497   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
498   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
499   CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
500
501   IF( ln_zdftke.OR.ln_zdfgls ) THEN
502!      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
503!      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
504!      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
505   ENDIF
506
507#endif
508   !
509END SUBROUTINE agrif_declare_var
510
511#if defined key_lim3
512SUBROUTINE Agrif_InitValues_cont_lim3
513   !!----------------------------------------------------------------------
514   !!                 *** ROUTINE Agrif_InitValues_cont_lim3 ***
515   !!
516   !! ** Purpose :: Initialisation of variables to be interpolated for LIM3
517   !!----------------------------------------------------------------------
518   USE Agrif_Util
519   USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
520   USE ice
521   USE agrif_ice
522   USE in_out_manager
523   USE agrif_lim3_update
524   USE agrif_lim3_interp
525   USE lib_mpp
526   !
527   IMPLICIT NONE
528   !!----------------------------------------------------------------------
529   !
530   ! Declaration of the type of variable which have to be interpolated (parent=>child)
531   !----------------------------------------------------------------------------------
532   CALL agrif_declare_var_lim3
533
534   ! Controls
535
536   ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal is largely degraded by the agrif zoom)
537   !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
538   !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
539   !       If a solution is found, the following stop could be removed
540   IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and lim3 do not work properly')
541
542   ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
543   IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
544      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
545   ENDIF
546   ! First Interpolations (using "after" ice subtime step => lim_nbstep=1)
547   !----------------------------------------------------------------------
548!!   lim_nbstep = 1
549   lim_nbstep = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong)
550   CALL agrif_interp_lim3('U') ! interpolation of ice velocities
551   CALL agrif_interp_lim3('V') ! interpolation of ice velocities
552   CALL agrif_interp_lim3('T') ! interpolation of ice tracers
553   lim_nbstep = 0
554   
555   ! Update in case 2 ways
556   !----------------------
557   CALL agrif_update_lim3(0)
558
559   !
560END SUBROUTINE Agrif_InitValues_cont_lim3
561
562SUBROUTINE agrif_declare_var_lim3
563   !!----------------------------------------------------------------------
564   !!                 *** ROUTINE agrif_declare_var_lim3 ***
565   !!
566   !! ** Purpose :: Declaration of variables to be interpolated for LIM3
567   !!----------------------------------------------------------------------
568   USE Agrif_Util
569   USE ice
570   USE par_oce, ONLY : nbghostcells
571   !
572   IMPLICIT NONE
573   !
574   INTEGER :: ind1, ind2, ind3
575   !!----------------------------------------------------------------------
576   !
577   ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
578   !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
579   !           ex.:  position=> 1,1 = not-centered (in i and j)
580   !                            2,2 =     centered (    -     )
581   !                 index   => 1,1 = one ghost line
582   !                            2,2 = two ghost lines
583   !-------------------------------------------------------------------------------------
584   ind1 =     nbghostcells
585   ind2 = 1 + nbghostcells
586   ind3 = 2 + nbghostcells
587   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id )
588   CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
589   CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
590
591   ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
592   !-----------------------------------
593   CALL Agrif_Set_bcinterp(tra_ice_id,  interp = AGRIF_linear)
594   CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
595   CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
596
597   ! 3. Set location of interpolations
598   !----------------------------------
599   CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
600   CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
601   CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
602
603   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
604   !--------------------------------------------------
605   CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
606   CALL Agrif_Set_Updatetype(u_ice_id  ,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
607   CALL Agrif_Set_Updatetype(v_ice_id  ,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
608
609END SUBROUTINE agrif_declare_var_lim3
610#endif
611
612
613# if defined key_top
614SUBROUTINE Agrif_InitValues_cont_top
615   !!----------------------------------------------------------------------
616   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
617   !!
618   !! ** Purpose :: Declaration of variables to be interpolated
619   !!----------------------------------------------------------------------
620   USE Agrif_Util
621   USE oce 
622   USE dom_oce
623   USE nemogcm
624   USE par_trc
625   USE lib_mpp
626   USE trc
627   USE in_out_manager
628   USE agrif_opa_sponge
629   USE agrif_top_update
630   USE agrif_top_interp
631   USE agrif_top_sponge
632   !!
633   IMPLICIT NONE
634   !
635   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
636   LOGICAL :: check_namelist
637   !!----------------------------------------------------------------------
638
639
640   ! 1. Declaration of the type of variable which have to be interpolated
641   !---------------------------------------------------------------------
642   CALL agrif_declare_var_top
643
644   ! 2. First interpolations of potentially non zero fields
645   !-------------------------------------------------------
646   Agrif_SpecialValue=0.
647   Agrif_UseSpecialValue = .TRUE.
648   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
649   Agrif_UseSpecialValue = .FALSE.
650   CALL Agrif_Sponge
651   tabspongedone_trn = .FALSE.
652   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
653   ! reset tsa to zero
654   tra(:,:,:,:) = 0.
655
656
657   ! 3. Some controls
658   !-----------------
659   check_namelist = .TRUE.
660
661   IF( check_namelist ) THEN
662      ! Check time steps
663      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
664         WRITE(cl_check1,*)  Agrif_Parent(rdt)
665         WRITE(cl_check2,*)  rdt
666         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
667         CALL ctl_stop( 'incompatible time step between grids',   &
668               &               'parent grid value : '//cl_check1    ,   & 
669               &               'child  grid value : '//cl_check2    ,   & 
670               &               'value on child grid should be changed to  &
671               &               :'//cl_check3  )
672      ENDIF
673
674      ! Check run length
675      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
676            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
677         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
678         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
679         CALL ctl_warn( 'incompatible run length between grids'               ,   &
680               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
681               &              ' nitend on fine grid will be change to : '//cl_check2    )
682         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
683         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
684      ENDIF
685
686      ENDIF
687      ! Check passive tracer cell
688      IF( nn_dttrc .NE. 1 ) THEN
689         WRITE(*,*) 'nn_dttrc should be equal to 1'
690      ENDIF
691   ENDIF
692   !
693END SUBROUTINE Agrif_InitValues_cont_top
694
695
696SUBROUTINE agrif_declare_var_top
697   !!----------------------------------------------------------------------
698   !!                 *** ROUTINE agrif_declare_var_top ***
699   !!
700   !! ** Purpose :: Declaration of TOP variables to be interpolated
701   !!----------------------------------------------------------------------
702   USE agrif_util
703   USE agrif_oce
704   USE dom_oce
705   USE trc
706   !!
707   IMPLICIT NONE
708   !
709   INTEGER :: ind1, ind2, ind3
710   !!----------------------------------------------------------------------
711
712   ! 1. Declaration of the type of variable which have to be interpolated
713   !---------------------------------------------------------------------
714   ind1 =     nbghostcells
715   ind2 = 1 + nbghostcells
716   ind3 = 2 + nbghostcells
717# if defined key_vertical
718   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id)
719   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id)
720# else
721   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)
722   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)
723# endif
724
725   ! 2. Type of interpolation
726   !-------------------------
727   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
728   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
729
730   ! 3. Location of interpolation
731   !-----------------------------
732   CALL Agrif_Set_bc(trn_id,(/0,ind1/))
733   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
734
735   ! 4. Update type
736   !---------------
737# if defined UPD_HIGH
738   CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
739#else
740   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
741#endif
742   !
743END SUBROUTINE agrif_declare_var_top
744# endif
745
746SUBROUTINE Agrif_detect( kg, ksizex )
747   !!----------------------------------------------------------------------
748   !!                      *** ROUTINE Agrif_detect ***
749   !!----------------------------------------------------------------------
750   INTEGER, DIMENSION(2) :: ksizex
751   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
752   !!----------------------------------------------------------------------
753   !
754   RETURN
755   !
756END SUBROUTINE Agrif_detect
757
758
759SUBROUTINE agrif_nemo_init
760   !!----------------------------------------------------------------------
761   !!                     *** ROUTINE agrif_init ***
762   !!----------------------------------------------------------------------
763   USE agrif_oce 
764   USE agrif_ice
765   USE in_out_manager
766   USE lib_mpp
767   !!
768   IMPLICIT NONE
769   !
770   INTEGER  ::   ios                 ! Local integer output status for namelist read
771   INTEGER  ::   iminspon
772   NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
773   !!--------------------------------------------------------------------------------------
774   !
775   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
776   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
777901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
778
779   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
780   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
781902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
782   IF(lwm) WRITE ( numond, namagrif )
783   !
784   IF(lwp) THEN                    ! control print
785      WRITE(numout,*)
786      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
787      WRITE(numout,*) '~~~~~~~~~~~~~~~'
788      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
789      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
790      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
791      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
792      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
793      WRITE(numout,*) 
794   ENDIF
795   !
796   ! convert DOCTOR namelist name into OLD names
797   visc_tra      = rn_sponge_tra
798   visc_dyn      = rn_sponge_dyn
799   !
800   ! Check sponge length:
801   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
802   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
803   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
804   !
805   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
806   !
807END SUBROUTINE agrif_nemo_init
808
809# if defined key_mpp_mpi
810
811SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
812   !!----------------------------------------------------------------------
813   !!                     *** ROUTINE Agrif_InvLoc ***
814   !!----------------------------------------------------------------------
815   USE dom_oce
816   !!
817   IMPLICIT NONE
818   !
819   INTEGER :: indglob, indloc, nprocloc, i
820   !!----------------------------------------------------------------------
821   !
822   SELECT CASE( i )
823   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
824   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
825   CASE DEFAULT
826      indglob = indloc
827   END SELECT
828   !
829END SUBROUTINE Agrif_InvLoc
830
831
832SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
833   !!----------------------------------------------------------------------
834   !!                 *** ROUTINE Agrif_get_proc_info ***
835   !!----------------------------------------------------------------------
836   USE par_oce
837   !!
838   IMPLICIT NONE
839   !
840   INTEGER, INTENT(out) :: imin, imax
841   INTEGER, INTENT(out) :: jmin, jmax
842   !!----------------------------------------------------------------------
843   !
844   imin = nimppt(Agrif_Procrank+1)  ! ?????
845   jmin = njmppt(Agrif_Procrank+1)  ! ?????
846   imax = imin + jpi - 1
847   jmax = jmin + jpj - 1
848   !
849END SUBROUTINE Agrif_get_proc_info
850
851
852SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
853   !!----------------------------------------------------------------------
854   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
855   !!----------------------------------------------------------------------
856   USE par_oce
857   !!
858   IMPLICIT NONE
859   !
860   INTEGER,  INTENT(in)  :: imin, imax
861   INTEGER,  INTENT(in)  :: jmin, jmax
862   INTEGER,  INTENT(in)  :: nbprocs
863   REAL(wp), INTENT(out) :: grid_cost
864   !!----------------------------------------------------------------------
865   !
866   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
867   !
868END SUBROUTINE Agrif_estimate_parallel_cost
869
870# endif
871
872#else
873SUBROUTINE Subcalledbyagrif
874   !!----------------------------------------------------------------------
875   !!                   *** ROUTINE Subcalledbyagrif ***
876   !!----------------------------------------------------------------------
877   WRITE(*,*) 'Impossible to be here'
878END SUBROUTINE Subcalledbyagrif
879#endif
Note: See TracBrowser for help on using the repository browser.