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

Last change on this file since 5081 was 5081, checked in by smasson, 9 years ago

dev_r4765_CNRS_agrif: final version of tke/agrif?
  • Property svn:keywords set to Id
File size: 32.5 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   CALL Agrif_Update_tke(0)
319# endif
320   !
321   Agrif_UseSpecialValueInUpdate = .FALSE.
322   nbcline = 0
323   lk_agrif_doupd = .FALSE.
324   !
325END SUBROUTINE Agrif_InitValues_cont
326
327
328SUBROUTINE agrif_declare_var
329   !!----------------------------------------------------------------------
330   !!                 *** ROUTINE agrif_declarE_var ***
331   !!
332   !! ** Purpose :: Declaration of variables to be interpolated
333   !!----------------------------------------------------------------------
334   USE agrif_util
335   USE par_oce       !   ONLY : jpts
336   USE oce
337   USE agrif_oce
338   IMPLICIT NONE
339   !!----------------------------------------------------------------------
340
341   ! 1. Declaration of the type of variable which have to be interpolated
342   !---------------------------------------------------------------------
343   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)
344   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)
345
346   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
347   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
348   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
349   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
350   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
351   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
352
353   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
354   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
355   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
356
357   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)
358
359   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
360   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
361   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
362   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
363   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
364   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
365
366   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
367
368# if defined key_zdftke
369   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
370   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
371   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
372# endif
373
374   ! 2. Type of interpolation
375   !-------------------------
376   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
377
378   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
379   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
380
381   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
382
383   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
384   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
385   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
386   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
387   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
388
389
390   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
391   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
392
393   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
394   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
395   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
396
397# if defined key_zdftke
398   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear)
399# endif
400
401
402   ! 3. Location of interpolation
403   !-----------------------------
404   CALL Agrif_Set_bc(tsn_id,(/0,1/))
405   CALL Agrif_Set_bc(un_interp_id,(/0,1/))
406   CALL Agrif_Set_bc(vn_interp_id,(/0,1/))
407
408!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))
409!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))
410!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))
411   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
412   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
413   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
414
415   CALL Agrif_Set_bc(sshn_id,(/0,0/))
416   CALL Agrif_Set_bc(unb_id ,(/0,0/))
417   CALL Agrif_Set_bc(vnb_id ,(/0,0/))
418   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
419   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
420
421   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9
422   CALL Agrif_Set_bc(umsk_id,(/0,0/))
423   CALL Agrif_Set_bc(vmsk_id,(/0,0/))
424
425# if defined key_zdftke
426   CALL Agrif_Set_bc(avm_id ,(/0,1/))
427# endif
428
429   ! 5. Update type
430   !---------------
431   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
432
433   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
434
435   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
436   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
437
438   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
439
440   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
441   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
442
443# if defined key_zdftke
444   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
445   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
446   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
447# endif
448
449! High order updates
450!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
451!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
452!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
453!
454!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
455!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
456!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
457 
458   !
459END SUBROUTINE agrif_declare_var
460# endif
461
462#  if defined key_lim2
463SUBROUTINE Agrif_InitValues_cont_lim2
464   !!----------------------------------------------------------------------
465   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 ***
466   !!
467   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2
468   !!----------------------------------------------------------------------
469   USE Agrif_Util
470   USE ice_2
471   USE agrif_ice
472   USE in_out_manager
473   USE agrif_lim2_update
474   USE agrif_lim2_interp
475   USE lib_mpp
476   !
477   IMPLICIT NONE
478   !
479   !!----------------------------------------------------------------------
480
481   ! 1. Declaration of the type of variable which have to be interpolated
482   !---------------------------------------------------------------------
483   CALL agrif_declare_var_lim2
484
485   ! 2. First interpolations of potentially non zero fields
486   !-------------------------------------------------------
487   Agrif_SpecialValue=-9999.
488   Agrif_UseSpecialValue = .TRUE.
489   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )
490   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   )
491   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   )
492   Agrif_SpecialValue=0.
493   Agrif_UseSpecialValue = .FALSE.
494
495   ! 3. Some controls
496   !-----------------
497
498#   if ! defined key_lim2_vp
499   lim_nbstep = 1.
500   CALL agrif_rhg_lim2_load
501   CALL agrif_trp_lim2_load
502   lim_nbstep = 0.
503#   endif
504   !RB mandatory but why ???
505   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN
506   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')
507   !         nbclineupdate = nn_fsbc
508   !       ENDIF
509   CALL Agrif_Update_lim2(0)
510   !
511END SUBROUTINE Agrif_InitValues_cont_lim2
512
513SUBROUTINE agrif_declare_var_lim2
514   !!----------------------------------------------------------------------
515   !!                 *** ROUTINE agrif_declare_var_lim2 ***
516   !!
517   !! ** Purpose :: Declaration of variables to be interpolated for LIM2
518   !!----------------------------------------------------------------------
519   USE agrif_util
520   USE ice_2
521
522   IMPLICIT NONE
523   !!----------------------------------------------------------------------
524
525   ! 1. Declaration of the type of variable which have to be interpolated
526   !---------------------------------------------------------------------
527   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )
528#   if defined key_lim2_vp
529   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
530   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
531#   else
532   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
533   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
534#   endif
535
536   ! 2. Type of interpolation
537   !-------------------------
538   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
539   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
540   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
541
542   ! 3. Location of interpolation
543   !-----------------------------
544   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))
545   CALL Agrif_Set_bc(u_ice_id,(/0,1/))
546   CALL Agrif_Set_bc(v_ice_id,(/0,1/))
547
548   ! 5. Update type
549   !---------------
550   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
551   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
552   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
553   !
554END SUBROUTINE agrif_declare_var_lim2
555#  endif
556
557
558# if defined key_top
559SUBROUTINE Agrif_InitValues_cont_top
560   !!----------------------------------------------------------------------
561   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
562   !!
563   !! ** Purpose :: Declaration of variables to be interpolated
564   !!----------------------------------------------------------------------
565   USE Agrif_Util
566   USE oce 
567   USE dom_oce
568   USE nemogcm
569   USE par_trc
570   USE lib_mpp
571   USE trc
572   USE in_out_manager
573   USE agrif_opa_sponge
574   USE agrif_top_update
575   USE agrif_top_interp
576   USE agrif_top_sponge
577   !
578   IMPLICIT NONE
579   !
580   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
581   LOGICAL :: check_namelist
582   !!----------------------------------------------------------------------
583
584
585   ! 1. Declaration of the type of variable which have to be interpolated
586   !---------------------------------------------------------------------
587   CALL agrif_declare_var_top
588
589   ! 2. First interpolations of potentially non zero fields
590   !-------------------------------------------------------
591   Agrif_SpecialValue=0.
592   Agrif_UseSpecialValue = .TRUE.
593   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
594   Agrif_UseSpecialValue = .FALSE.
595   CALL Agrif_Sponge
596   tabspongedone_trn = .FALSE.
597   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
598   ! reset tsa to zero
599   tra(:,:,:,:) = 0.
600
601
602   ! 3. Some controls
603   !-----------------
604   check_namelist = .TRUE.
605
606   IF( check_namelist ) THEN
607# if defined key_offline
608      ! Check time steps
609      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
610         WRITE(cl_check1,*)  Agrif_Parent(rdt)
611         WRITE(cl_check2,*)  rdt
612         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
613         CALL ctl_warn( 'incompatible time step between grids',   &
614               &               'parent grid value : '//cl_check1    ,   & 
615               &               'child  grid value : '//cl_check2    ,   & 
616               &               'value on child grid will be changed to  &
617               &               :'//cl_check3  )
618         rdt=rdt*Agrif_Rhot()
619      ENDIF
620
621      ! Check run length
622      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
623            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
624         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
625         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
626         CALL ctl_warn( 'incompatible run length between grids'               ,   &
627               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
628               &              ' nitend on fine grid will be change to : '//cl_check2    )
629         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
630         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
631      ENDIF
632
633      ! Check coordinates
634      IF( ln_zps ) THEN
635         ! check parameters for partial steps
636         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
637            WRITE(*,*) 'incompatible e3zps_min between grids'
638            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
639            WRITE(*,*) 'child grid  :',e3zps_min
640            WRITE(*,*) 'those values should be identical'
641            STOP
642         ENDIF
643         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN
644            WRITE(*,*) 'incompatible e3zps_rat between grids'
645            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
646            WRITE(*,*) 'child grid  :',e3zps_rat
647            WRITE(*,*) 'those values should be identical'                 
648            STOP
649         ENDIF
650      ENDIF
651#  endif         
652      ! Check passive tracer cell
653      IF( nn_dttrc .NE. 1 ) THEN
654         WRITE(*,*) 'nn_dttrc should be equal to 1'
655      ENDIF
656   ENDIF
657
658   CALL Agrif_Update_trc(0)
659   !
660   Agrif_UseSpecialValueInUpdate = .FALSE.
661   nbcline_trc = 0
662   !
663END SUBROUTINE Agrif_InitValues_cont_top
664
665
666SUBROUTINE agrif_declare_var_top
667   !!----------------------------------------------------------------------
668   !!                 *** ROUTINE agrif_declare_var_top ***
669   !!
670   !! ** Purpose :: Declaration of TOP variables to be interpolated
671   !!----------------------------------------------------------------------
672   USE agrif_util
673   USE agrif_oce
674   USE dom_oce
675   USE trc
676
677   IMPLICIT NONE
678
679   ! 1. Declaration of the type of variable which have to be interpolated
680   !---------------------------------------------------------------------
681   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)
682   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)
683
684   ! 2. Type of interpolation
685   !-------------------------
686   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
687   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
688
689   ! 3. Location of interpolation
690   !-----------------------------
691   CALL Agrif_Set_bc(trn_id,(/0,1/))
692!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))
693   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
694
695   ! 5. Update type
696   !---------------
697   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
698
699!   Higher order update
700!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
701
702   !
703END SUBROUTINE agrif_declare_var_top
704# endif
705
706SUBROUTINE Agrif_detect( kg, ksizex )
707   !!----------------------------------------------------------------------
708   !!   *** ROUTINE Agrif_detect ***
709   !!----------------------------------------------------------------------
710   !
711   INTEGER, DIMENSION(2) :: ksizex
712   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
713   !!----------------------------------------------------------------------
714   !
715   RETURN
716   !
717END SUBROUTINE Agrif_detect
718
719
720SUBROUTINE agrif_nemo_init
721   !!----------------------------------------------------------------------
722   !!                     *** ROUTINE agrif_init ***
723   !!----------------------------------------------------------------------
724   USE agrif_oce 
725   USE agrif_ice
726   USE in_out_manager
727   USE lib_mpp
728   IMPLICIT NONE
729   !
730   INTEGER  ::   ios                 ! Local integer output status for namelist read
731   INTEGER  ::   iminspon
732   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
733   !!--------------------------------------------------------------------------------------
734   !
735   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
736   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
737901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
738
739   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
740   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
741902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
742   IF(lwm) WRITE ( numond, namagrif )
743   !
744   IF(lwp) THEN                    ! control print
745      WRITE(numout,*)
746      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
747      WRITE(numout,*) '~~~~~~~~~~~~~~~'
748      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
749      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
750      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
751      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
752      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
753      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
754      WRITE(numout,*) 
755   ENDIF
756   !
757   ! convert DOCTOR namelist name into OLD names
758   nbclineupdate = nn_cln_update
759   visc_tra      = rn_sponge_tra
760   visc_dyn      = rn_sponge_dyn
761   !
762   ! Check sponge length:
763   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
764   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
765   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
766   !
767   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
768# if defined key_lim2
769   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed')
770# endif
771   !
772END SUBROUTINE agrif_nemo_init
773
774# if defined key_mpp_mpi
775
776SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
777   !!----------------------------------------------------------------------
778   !!                     *** ROUTINE Agrif_detect ***
779   !!----------------------------------------------------------------------
780   USE dom_oce
781   IMPLICIT NONE
782   !
783   INTEGER :: indglob, indloc, nprocloc, i
784   !!----------------------------------------------------------------------
785   !
786   SELECT CASE( i )
787   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
788   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
789   CASE DEFAULT
790      indglob = indloc
791   END SELECT
792   !
793END SUBROUTINE Agrif_InvLoc
794
795SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
796   !!----------------------------------------------------------------------
797   !!                 *** ROUTINE Agrif_get_proc_info ***
798   !!----------------------------------------------------------------------
799   USE par_oce
800   IMPLICIT NONE
801   !
802   INTEGER, INTENT(out) :: imin, imax
803   INTEGER, INTENT(out) :: jmin, jmax
804   !!----------------------------------------------------------------------
805   !
806   imin = nimppt(Agrif_Procrank+1)  ! ?????
807   jmin = njmppt(Agrif_Procrank+1)  ! ?????
808   imax = imin + jpi - 1
809   jmax = jmin + jpj - 1
810   !
811END SUBROUTINE Agrif_get_proc_info
812
813SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
814   !!----------------------------------------------------------------------
815   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
816   !!----------------------------------------------------------------------
817   USE par_oce
818   IMPLICIT NONE
819   !
820   INTEGER,  INTENT(in)  :: imin, imax
821   INTEGER,  INTENT(in)  :: jmin, jmax
822   INTEGER,  INTENT(in)  :: nbprocs
823   REAL(wp), INTENT(out) :: grid_cost
824   !!----------------------------------------------------------------------
825   !
826   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
827   !
828END SUBROUTINE Agrif_estimate_parallel_cost
829
830# endif
831
832#else
833SUBROUTINE Subcalledbyagrif
834   !!----------------------------------------------------------------------
835   !!                   *** ROUTINE Subcalledbyagrif ***
836   !!----------------------------------------------------------------------
837   WRITE(*,*) 'Impossible to be here'
838END SUBROUTINE Subcalledbyagrif
839#endif
Note: See TracBrowser for help on using the repository browser.