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/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 4984

Last change on this file since 4984 was 4984, checked in by jchanut, 9 years ago

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