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 @ 9031

Last change on this file since 9031 was 9031, checked in by timgraham, 6 years ago

Resolved AGRIF conflicts
  • Property svn:keywords set to Id
File size: 36.3 KB
Line 
1#define 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   IF (.NOT.ln_linssh) CALL Agrif_Update_vvl()
340   CALL Agrif_Update_tra()
341#if defined key_top
342   CALL Agrif_Update_Trc()
343#endif
344   CALL Agrif_Update_dyn()
345! JC remove update because this precludes from perfect restartability
346!!   CALL Agrif_Update_tke(0)
347
348   CALL Agrif_ChildGrid_To_ParentGrid()
349   CALL Agrif_Update_ini()
350   CALL Agrif_ParentGrid_To_ChildGrid()
351
352END SUBROUTINE agrif_update_ini
353
354SUBROUTINE agrif_declare_var
355   !!----------------------------------------------------------------------
356   !!                 *** ROUTINE agrif_declarE_var ***
357   !!
358   !! ** Purpose :: Declaration of variables to be interpolated
359   !!----------------------------------------------------------------------
360   USE agrif_util
361   USE agrif_oce
362   USE par_oce       ! ocean parameters
363   USE zdf_oce       ! vertical physics
364   USE oce
365   !
366   IMPLICIT NONE
367   !
368   INTEGER :: ind1, ind2, ind3
369   !!----------------------------------------------------------------------
370
371   ! 1. Declaration of the type of variable which have to be interpolated
372   !---------------------------------------------------------------------
373   ind1 =     nbghostcells
374   ind2 = 1 + nbghostcells
375   ind3 = 2 + nbghostcells
376# if defined key_vertical
377   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)
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_sponge_id)
379
380   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)
381   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)
382   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)
383   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)
384   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)
385   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)
386# else
387   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)
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_sponge_id)
389
390   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)
391   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)
392   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)
393   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)
394   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)
395   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)
396# endif
397
398   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
399   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
400   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
401
402   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)
403
404   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
405   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
406   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
407   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
408   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
409   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
410
411   CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
412
413   IF( ln_zdftke ) THEN
414      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
415      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
416# if defined key_vertical
417   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)
418# else
419   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)
420# endif
421   ENDIF
422
423   ! 2. Type of interpolation
424   !-------------------------
425   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
426
427   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
428   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
429
430   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
431
432   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
433   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
434   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
435   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
436   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
437
438
439   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
440   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
441
442   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
443   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
444   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
445
446   IF( ln_zdftke )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
447
448   ! 3. Location of interpolation
449   !-----------------------------
450   CALL Agrif_Set_bc(       tsn_id, (/0,ind1/) )
451   CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) )
452   CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) )
453
454   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
455   CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
456   CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
457
458   CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) )
459   CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) )
460   CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) )
461   CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
462   CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
463
464   CALL Agrif_Set_bc(  e3t_id, (/-2*Agrif_irhox()-1,ind1-1/) )   ! if west and rhox=3 and ghost=1: column 2 to 9
465   CALL Agrif_Set_bc( umsk_id, (/0,ind1-1/)                  )
466   CALL Agrif_Set_bc( vmsk_id, (/0,ind1-1/)                  )
467
468   IF( ln_zdftke )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
469
470   ! 4. Update type
471   !---------------
472   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
473
474# if defined UPD_HIGH
475   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
476   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
477   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
478
479   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
480   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
481   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
482   CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
483
484   IF( ln_zdftke) THEN
485      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
486      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
487      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
488   ENDIF
489
490#else
491   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
492   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
493   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
494
495   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
496   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
497   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
498   CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
499
500   IF( ln_zdftke) THEN
501      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
502      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
503      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
504   ENDIF
505
506#endif
507   !
508END SUBROUTINE agrif_declare_var
509
510#if defined key_lim3
511SUBROUTINE Agrif_InitValues_cont_lim3
512   !!----------------------------------------------------------------------
513   !!                 *** ROUTINE Agrif_InitValues_cont_lim3 ***
514   !!
515   !! ** Purpose :: Initialisation of variables to be interpolated for LIM3
516   !!----------------------------------------------------------------------
517   USE Agrif_Util
518   USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
519   USE ice
520   USE agrif_ice
521   USE in_out_manager
522   USE agrif_lim3_update
523   USE agrif_lim3_interp
524   USE lib_mpp
525   !
526   IMPLICIT NONE
527   !!----------------------------------------------------------------------
528   !
529   ! Declaration of the type of variable which have to be interpolated (parent=>child)
530   !----------------------------------------------------------------------------------
531   CALL agrif_declare_var_lim3
532
533   ! Controls
534
535   ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal is largely degraded by the agrif zoom)
536   !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
537   !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
538   !       If a solution is found, the following stop could be removed
539   IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and lim3 do not work properly')
540
541   ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
542   IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
543      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
544   ENDIF
545   ! First Interpolations (using "after" ice subtime step => lim_nbstep=1)
546   !----------------------------------------------------------------------
547!!   lim_nbstep = 1
548   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)
549   CALL agrif_interp_lim3('U') ! interpolation of ice velocities
550   CALL agrif_interp_lim3('V') ! interpolation of ice velocities
551   CALL agrif_interp_lim3('T') ! interpolation of ice tracers
552   lim_nbstep = 0
553   
554   ! Update in case 2 ways
555   !----------------------
556   CALL agrif_update_lim3(0)
557
558   !
559END SUBROUTINE Agrif_InitValues_cont_lim3
560
561SUBROUTINE agrif_declare_var_lim3
562   !!----------------------------------------------------------------------
563   !!                 *** ROUTINE agrif_declare_var_lim3 ***
564   !!
565   !! ** Purpose :: Declaration of variables to be interpolated for LIM3
566   !!----------------------------------------------------------------------
567   USE Agrif_Util
568   USE ice
569   USE par_oce, ONLY : nbghostcells
570   !
571   IMPLICIT NONE
572   !
573   INTEGER :: ind1, ind2, ind3
574   !!----------------------------------------------------------------------
575   !
576   ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
577   !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
578   !           ex.:  position=> 1,1 = not-centered (in i and j)
579   !                            2,2 =     centered (    -     )
580   !                 index   => 1,1 = one ghost line
581   !                            2,2 = two ghost lines
582   !-------------------------------------------------------------------------------------
583   ind1 =     nbghostcells
584   ind2 = 1 + nbghostcells
585   ind3 = 2 + nbghostcells
586   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 )
587   CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
588   CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
589
590   ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
591   !-----------------------------------
592   CALL Agrif_Set_bcinterp(tra_ice_id,  interp = AGRIF_linear)
593   CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
594   CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
595
596   ! 3. Set location of interpolations
597   !----------------------------------
598   CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
599   CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
600   CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
601
602   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
603   !--------------------------------------------------
604   CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
605   CALL Agrif_Set_Updatetype(u_ice_id  ,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
606   CALL Agrif_Set_Updatetype(v_ice_id  ,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
607
608END SUBROUTINE agrif_declare_var_lim3
609#endif
610
611
612# if defined key_top
613SUBROUTINE Agrif_InitValues_cont_top
614   !!----------------------------------------------------------------------
615   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
616   !!
617   !! ** Purpose :: Declaration of variables to be interpolated
618   !!----------------------------------------------------------------------
619   USE Agrif_Util
620   USE oce 
621   USE dom_oce
622   USE nemogcm
623   USE par_trc
624   USE lib_mpp
625   USE trc
626   USE in_out_manager
627   USE agrif_opa_sponge
628   USE agrif_top_update
629   USE agrif_top_interp
630   USE agrif_top_sponge
631   !!
632   IMPLICIT NONE
633   !
634   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
635   LOGICAL :: check_namelist
636   !!----------------------------------------------------------------------
637
638
639   ! 1. Declaration of the type of variable which have to be interpolated
640   !---------------------------------------------------------------------
641   CALL agrif_declare_var_top
642
643   ! 2. First interpolations of potentially non zero fields
644   !-------------------------------------------------------
645   Agrif_SpecialValue=0.
646   Agrif_UseSpecialValue = .TRUE.
647   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
648   Agrif_UseSpecialValue = .FALSE.
649   CALL Agrif_Sponge
650   tabspongedone_trn = .FALSE.
651   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
652   ! reset tsa to zero
653   tra(:,:,:,:) = 0.
654
655
656   ! 3. Some controls
657   !-----------------
658   check_namelist = .TRUE.
659
660   IF( check_namelist ) THEN
661      ! Check time steps
662      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
663         WRITE(cl_check1,*)  Agrif_Parent(rdt)
664         WRITE(cl_check2,*)  rdt
665         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
666         CALL ctl_stop( 'incompatible time step between grids',   &
667               &               'parent grid value : '//cl_check1    ,   & 
668               &               'child  grid value : '//cl_check2    ,   & 
669               &               'value on child grid should be changed to  &
670               &               :'//cl_check3  )
671      ENDIF
672
673      ! Check run length
674      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
675            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
676         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
677         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
678         CALL ctl_warn( 'incompatible run length between grids'               ,   &
679               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
680               &              ' nitend on fine grid will be change to : '//cl_check2    )
681         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
682         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
683      ENDIF
684
685      ENDIF
686      ! Check passive tracer cell
687      IF( nn_dttrc .NE. 1 ) THEN
688         WRITE(*,*) 'nn_dttrc should be equal to 1'
689      ENDIF
690   ENDIF
691   !
692END SUBROUTINE Agrif_InitValues_cont_top
693
694
695SUBROUTINE agrif_declare_var_top
696   !!----------------------------------------------------------------------
697   !!                 *** ROUTINE agrif_declare_var_top ***
698   !!
699   !! ** Purpose :: Declaration of TOP variables to be interpolated
700   !!----------------------------------------------------------------------
701   USE agrif_util
702   USE agrif_oce
703   USE dom_oce
704   USE trc
705   !!
706   IMPLICIT NONE
707   !
708   INTEGER :: ind1, ind2, ind3
709   !!----------------------------------------------------------------------
710
711   ! 1. Declaration of the type of variable which have to be interpolated
712   !---------------------------------------------------------------------
713   ind1 =     nbghostcells
714   ind2 = 1 + nbghostcells
715   ind3 = 2 + nbghostcells
716# if defined key_vertical
717   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)
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_sponge_id)
719# else
720   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)
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_sponge_id)
722# endif
723
724   ! 2. Type of interpolation
725   !-------------------------
726   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
727   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
728
729   ! 3. Location of interpolation
730   !-----------------------------
731   CALL Agrif_Set_bc(trn_id,(/0,ind1/))
732   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
733
734   ! 4. Update type
735   !---------------
736# if defined UPD_HIGH
737   CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
738#else
739   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
740#endif
741   !
742END SUBROUTINE agrif_declare_var_top
743# endif
744
745SUBROUTINE Agrif_detect( kg, ksizex )
746   !!----------------------------------------------------------------------
747   !!                      *** ROUTINE Agrif_detect ***
748   !!----------------------------------------------------------------------
749   INTEGER, DIMENSION(2) :: ksizex
750   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
751   !!----------------------------------------------------------------------
752   !
753   RETURN
754   !
755END SUBROUTINE Agrif_detect
756
757
758SUBROUTINE agrif_nemo_init
759   !!----------------------------------------------------------------------
760   !!                     *** ROUTINE agrif_init ***
761   !!----------------------------------------------------------------------
762   USE agrif_oce 
763   USE agrif_ice
764   USE in_out_manager
765   USE lib_mpp
766   !!
767   IMPLICIT NONE
768   !
769   INTEGER  ::   ios                 ! Local integer output status for namelist read
770   INTEGER  ::   iminspon
771   NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
772   !!--------------------------------------------------------------------------------------
773   !
774   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
775   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
776901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
777
778   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
779   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
780902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
781   IF(lwm) WRITE ( numond, namagrif )
782   !
783   IF(lwp) THEN                    ! control print
784      WRITE(numout,*)
785      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
786      WRITE(numout,*) '~~~~~~~~~~~~~~~'
787      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
788      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
789      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
790      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
791      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
792      WRITE(numout,*) 
793   ENDIF
794   !
795   ! convert DOCTOR namelist name into OLD names
796   visc_tra      = rn_sponge_tra
797   visc_dyn      = rn_sponge_dyn
798   !
799   ! Check sponge length:
800   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
801   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
802   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
803   !
804   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
805   !
806END SUBROUTINE agrif_nemo_init
807
808# if defined key_mpp_mpi
809
810SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
811   !!----------------------------------------------------------------------
812   !!                     *** ROUTINE Agrif_InvLoc ***
813   !!----------------------------------------------------------------------
814   USE dom_oce
815   !!
816   IMPLICIT NONE
817   !
818   INTEGER :: indglob, indloc, nprocloc, i
819   !!----------------------------------------------------------------------
820   !
821   SELECT CASE( i )
822   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
823   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
824   CASE DEFAULT
825      indglob = indloc
826   END SELECT
827   !
828END SUBROUTINE Agrif_InvLoc
829
830
831SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
832   !!----------------------------------------------------------------------
833   !!                 *** ROUTINE Agrif_get_proc_info ***
834   !!----------------------------------------------------------------------
835   USE par_oce
836   !!
837   IMPLICIT NONE
838   !
839   INTEGER, INTENT(out) :: imin, imax
840   INTEGER, INTENT(out) :: jmin, jmax
841   !!----------------------------------------------------------------------
842   !
843   imin = nimppt(Agrif_Procrank+1)  ! ?????
844   jmin = njmppt(Agrif_Procrank+1)  ! ?????
845   imax = imin + jpi - 1
846   jmax = jmin + jpj - 1
847   !
848END SUBROUTINE Agrif_get_proc_info
849
850
851SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
852   !!----------------------------------------------------------------------
853   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
854   !!----------------------------------------------------------------------
855   USE par_oce
856   !!
857   IMPLICIT NONE
858   !
859   INTEGER,  INTENT(in)  :: imin, imax
860   INTEGER,  INTENT(in)  :: jmin, jmax
861   INTEGER,  INTENT(in)  :: nbprocs
862   REAL(wp), INTENT(out) :: grid_cost
863   !!----------------------------------------------------------------------
864   !
865   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
866   !
867END SUBROUTINE Agrif_estimate_parallel_cost
868
869# endif
870
871#else
872SUBROUTINE Subcalledbyagrif
873   !!----------------------------------------------------------------------
874   !!                   *** ROUTINE Subcalledbyagrif ***
875   !!----------------------------------------------------------------------
876   WRITE(*,*) 'Impossible to be here'
877END SUBROUTINE Subcalledbyagrif
878#endif
Note: See TracBrowser for help on using the repository browser.