source: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 6079

Last change on this file since 6079 was 6079, checked in by jamesharle, 6 years ago

merge to trunk@5936

  • 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 nemogcm
20   !
21   IMPLICIT NONE
22   !!----------------------------------------------------------------------
23   !
24   IF( .NOT. Agrif_Root() ) THEN
25      jpni = Agrif_Parent(jpni)
26      jpnj = Agrif_Parent(jpnj)
27      jpnij = Agrif_Parent(jpnij)
28      jpiglo  = nbcellsx + 2 + 2*nbghostcells
29      jpjglo  = nbcellsy + 2 + 2*nbghostcells
30      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
31      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
32! JC: change to allow for different vertical levels
33!     jpk is already set
34!     keep it jpk possibly different from jpkdta which
35!     hold parent grid vertical levels number (set earlier)
36!      jpk     = jpkdta
37      jpim1   = jpi-1 
38      jpjm1   = jpj-1 
39      jpkm1   = jpk-1                                         
40      jpij    = jpi*jpj 
41      jpidta  = jpiglo
42      jpjdta  = jpjglo
43      jpizoom = 1
44      jpjzoom = 1
45      nperio  = 0
46      jperio  = 0
47   ENDIF
48   !
49END SUBROUTINE Agrif_InitWorkspace
50
51
52SUBROUTINE Agrif_InitValues
53   !!----------------------------------------------------------------------
54   !!                 *** ROUTINE Agrif_InitValues ***
55   !!
56   !! ** Purpose :: Declaration of variables to be interpolated
57   !!----------------------------------------------------------------------
58   USE Agrif_Util
59   USE oce 
60   USE dom_oce
61   USE nemogcm
62   USE tradmp
63   USE bdy_par
64
65   IMPLICIT NONE
66   !!----------------------------------------------------------------------
67   ! 0. Initializations
68   !-------------------
69   IF( cp_cfg == 'orca' ) THEN
70      IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 &
71            &                      .OR. jp_cfg == 4 ) THEN
72         jp_cfg = -1    ! set special value for jp_cfg on fine grids
73         cp_cfg = "default"
74      ENDIF
75   ENDIF
76   ! Specific fine grid Initializations
77   ! no tracer damping on fine grids
78   ln_tradmp = .FALSE.
79   ! no open boundary on fine grids
80   lk_bdy = .FALSE.
81
82
83   CALL nemo_init  ! Initializations of each fine grid
84
85   CALL agrif_nemo_init
86   CALL Agrif_InitValues_cont_dom
87# if ! defined key_offline
88   CALL Agrif_InitValues_cont
89# endif       
90# if defined key_top
91   CALL Agrif_InitValues_cont_top
92# endif     
93END SUBROUTINE Agrif_initvalues
94
95
96SUBROUTINE Agrif_InitValues_cont_dom
97   !!----------------------------------------------------------------------
98   !!                 *** ROUTINE Agrif_InitValues_cont ***
99   !!
100   !! ** Purpose ::   Declaration of variables to be interpolated
101   !!----------------------------------------------------------------------
102   USE Agrif_Util
103   USE oce 
104   USE dom_oce
105   USE nemogcm
106   USE in_out_manager
107   USE agrif_opa_update
108   USE agrif_opa_interp
109   USE agrif_opa_sponge
110   !
111   IMPLICIT NONE
112   !
113   !!----------------------------------------------------------------------
114
115   ! Declaration of the type of variable which have to be interpolated
116   !---------------------------------------------------------------------
117   CALL agrif_declare_var_dom
118   !
119END SUBROUTINE Agrif_InitValues_cont_dom
120
121
122SUBROUTINE agrif_declare_var_dom
123   !!----------------------------------------------------------------------
124   !!                 *** ROUTINE agrif_declare_var ***
125   !!
126   !! ** Purpose :: Declaration of variables to be interpolated
127   !!----------------------------------------------------------------------
128   USE agrif_util
129   USE par_oce       
130   USE oce
131   IMPLICIT NONE
132   !!----------------------------------------------------------------------
133
134   ! 1. Declaration of the type of variable which have to be interpolated
135   !---------------------------------------------------------------------
136   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
137   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
138
139   ! 2. Type of interpolation
140   !-------------------------
141   CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
142   CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
143
144   ! 3. Location of interpolation
145   !-----------------------------
146   CALL Agrif_Set_bc(e1u_id,(/0,0/))
147   CALL Agrif_Set_bc(e2v_id,(/0,0/))
148
149   ! 5. Update type
150   !---------------
151   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
152   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
153
154! High order updates
155!   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting)
156!   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average)
157    !
158END SUBROUTINE agrif_declare_var_dom
159
160
161# if ! defined key_offline
162
163SUBROUTINE Agrif_InitValues_cont
164   !!----------------------------------------------------------------------
165   !!                 *** ROUTINE Agrif_InitValues_cont ***
166   !!
167   !! ** Purpose ::   Declaration of variables to be interpolated
168   !!----------------------------------------------------------------------
169   USE Agrif_Util
170   USE oce 
171   USE dom_oce
172   USE nemogcm
173   USE lib_mpp
174   USE in_out_manager
175   USE agrif_opa_update
176   USE agrif_opa_interp
177   USE agrif_opa_sponge
178   !
179   IMPLICIT NONE
180   !
181   LOGICAL :: check_namelist
182   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3
183   !!----------------------------------------------------------------------
184
185   ! 1. Declaration of the type of variable which have to be interpolated
186   !---------------------------------------------------------------------
187   CALL agrif_declare_var
188
189   ! 2. First interpolations of potentially non zero fields
190   !-------------------------------------------------------
191   Agrif_SpecialValue=0.
192   Agrif_UseSpecialValue = .TRUE.
193   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
194   CALL Agrif_Sponge
195   tabspongedone_tsn = .FALSE.
196   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
197   ! reset tsa to zero
198   tsa(:,:,:,:) = 0.
199
200   Agrif_UseSpecialValue = ln_spc_dyn
201   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
202   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
203   tabspongedone_u = .FALSE.
204   tabspongedone_v = .FALSE.
205   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
206   tabspongedone_u = .FALSE.
207   tabspongedone_v = .FALSE.
208   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
209
210   Agrif_UseSpecialValue = .TRUE.
211   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
212
213   IF ( ln_dynspg_ts ) THEN
214      Agrif_UseSpecialValue = ln_spc_dyn
215      CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
216      CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
217      CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
218      CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
219      ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0
220      ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 
221      ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 
222      ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0
223   ENDIF
224
225   Agrif_UseSpecialValue = .FALSE. 
226   ! reset velocities to zero
227   ua(:,:,:) = 0.
228   va(:,:,:) = 0.
229
230   ! 3. Some controls
231   !-----------------
232   check_namelist = .TRUE.
233
234   IF( check_namelist ) THEN 
235
236      ! Check time steps           
237      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
238         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
239         WRITE(cl_check2,*)  NINT(rdt)
240         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
241         CALL ctl_warn( 'incompatible time step between grids',   &
242               &               'parent grid value : '//cl_check1    ,   & 
243               &               'child  grid value : '//cl_check2    ,   & 
244               &               'value on child grid will be changed to : '//cl_check3 )
245         rdt=Agrif_Parent(rdt)/Agrif_Rhot()
246      ENDIF
247
248      ! Check run length
249      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
250            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
251         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
252         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
253         CALL ctl_warn( 'incompatible run length between grids'               ,   &
254               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
255               &              ' nitend on fine grid will be change to : '//cl_check2    )
256         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
257         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
258      ENDIF
259
260      ! Check coordinates
261      IF( ln_zps ) THEN
262         ! check parameters for partial steps
263         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
264            WRITE(*,*) 'incompatible e3zps_min between grids'
265            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
266            WRITE(*,*) 'child grid  :',e3zps_min
267            WRITE(*,*) 'those values should be identical'
268            STOP
269         ENDIF
270         IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
271            WRITE(*,*) 'incompatible e3zps_rat between grids'
272            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
273            WRITE(*,*) 'child grid  :',e3zps_rat
274            WRITE(*,*) 'those values should be identical'                 
275            STOP
276         ENDIF
277      ENDIF
278
279      ! Check free surface scheme
280      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
281         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
282         WRITE(*,*) 'incompatible free surface scheme between grids'
283         WRITE(*,*) 'parent grid ln_dynspg_ts  :', Agrif_Parent(ln_dynspg_ts )
284         WRITE(*,*) 'parent grid ln_dynspg_exp :', Agrif_Parent(ln_dynspg_exp)
285         WRITE(*,*) 'child grid  ln_dynspg_ts  :', ln_dynspg_ts
286         WRITE(*,*) 'child grid  ln_dynspg_exp :', ln_dynspg_exp
287         WRITE(*,*) 'those logicals should be identical'                 
288         STOP
289      ENDIF
290
291      ! check if masks and bathymetries match
292      IF(ln_chk_bathy) THEN
293         !
294         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
295         !
296         kindic_agr = 0
297         ! check if umask agree with parent along western and eastern boundaries:
298         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
299         ! check if vmask agree with parent along northern and southern boundaries:
300         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
301    ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
302         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
303         !
304         IF (lk_mpp) CALL mpp_sum( kindic_agr )
305         IF( kindic_agr /= 0 ) THEN                   
306            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
307         ELSE
308            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
309         END IF
310      ENDIF
311      !
312   ENDIF
313   !
314   ! Do update at initialisation because not done before writing restarts
315   ! This would indeed change boundary conditions values at initial time
316   ! hence produce restartability issues.
317   ! Note that update below is recursive (with lk_agrif_doupd=T):
318   !
319! JC: I am not sure if Agrif_MaxLevel() is the "relative"
320!     or the absolute maximum nesting level...TBC                       
321   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 
322      ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics
323      CALL Agrif_Update_tra()
324      CALL Agrif_Update_dyn()
325   ENDIF
326   !
327# if defined key_zdftke
328   CALL Agrif_Update_tke(0)
329# endif
330   !
331   Agrif_UseSpecialValueInUpdate = .FALSE.
332   nbcline = 0 
333   lk_agrif_doupd = .FALSE.
334   !
335END SUBROUTINE Agrif_InitValues_cont
336
337
338SUBROUTINE agrif_declare_var
339   !!----------------------------------------------------------------------
340   !!                 *** ROUTINE agrif_declarE_var ***
341   !!
342   !! ** Purpose :: Declaration of variables to be interpolated
343   !!----------------------------------------------------------------------
344   USE agrif_util
345   USE par_oce       !   ONLY : jpts
346   USE oce
347   USE agrif_oce
348   IMPLICIT NONE
349   !!----------------------------------------------------------------------
350
351   ! 1. Declaration of the type of variable which have to be interpolated
352   !---------------------------------------------------------------------
353   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)
354   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)
355
356   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
357   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
358   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
359   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
360   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
361   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
362
363   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
364   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
365   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
366
367   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)
368
369   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
370   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
371   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
372   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
373   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
374   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
375
376   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
377
378# if defined key_zdftke
379   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
380   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
381   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
382# endif
383
384   ! 2. Type of interpolation
385   !-------------------------
386   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
387
388   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
389   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
390
391   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
392
393   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
394   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
395   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
396   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
397   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
398
399
400   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
401   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
402
403   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
404   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
405   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
406
407# if defined key_zdftke
408   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear)
409# endif
410
411
412   ! 3. Location of interpolation
413   !-----------------------------
414   CALL Agrif_Set_bc(tsn_id,(/0,1/))
415   CALL Agrif_Set_bc(un_interp_id,(/0,1/))
416   CALL Agrif_Set_bc(vn_interp_id,(/0,1/))
417
418!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))
419!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))
420!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))
421   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
422   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
423   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
424
425   CALL Agrif_Set_bc(sshn_id,(/0,0/))
426   CALL Agrif_Set_bc(unb_id ,(/0,0/))
427   CALL Agrif_Set_bc(vnb_id ,(/0,0/))
428   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
429   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
430
431   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9
432   CALL Agrif_Set_bc(umsk_id,(/0,0/))
433   CALL Agrif_Set_bc(vmsk_id,(/0,0/))
434
435# if defined key_zdftke
436   CALL Agrif_Set_bc(avm_id ,(/0,1/))
437# endif
438
439   ! 5. Update type
440   !---------------
441   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
442
443   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
444
445   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
446   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
447
448   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
449
450   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
451   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
452
453# if defined key_zdftke
454   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
455   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
456   CALL Agrif_Set_Updatetype(avm_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   !!--------------------------------------------------------------------------------------
744   !
745   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
746   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
747901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
748
749   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
750   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
751902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
752   IF(lwm) WRITE ( numond, namagrif )
753   !
754   IF(lwp) THEN                    ! control print
755      WRITE(numout,*)
756      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
757      WRITE(numout,*) '~~~~~~~~~~~~~~~'
758      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
759      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
760      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
761      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
762      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
763      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
764      WRITE(numout,*) 
765   ENDIF
766   !
767   ! convert DOCTOR namelist name into OLD names
768   nbclineupdate = nn_cln_update
769   visc_tra      = rn_sponge_tra
770   visc_dyn      = rn_sponge_dyn
771   !
772   ! Check sponge length:
773   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
774   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
775   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
776   !
777   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
778# if defined key_lim2
779   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed')
780# endif
781   !
782END SUBROUTINE agrif_nemo_init
783
784# if defined key_mpp_mpi
785
786SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
787   !!----------------------------------------------------------------------
788   !!                     *** ROUTINE Agrif_detect ***
789   !!----------------------------------------------------------------------
790   USE dom_oce
791   IMPLICIT NONE
792   !
793   INTEGER :: indglob, indloc, nprocloc, i
794   !!----------------------------------------------------------------------
795   !
796   SELECT CASE( i )
797   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
798   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
799   CASE DEFAULT
800      indglob = indloc
801   END SELECT
802   !
803END SUBROUTINE Agrif_InvLoc
804
805SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
806   !!----------------------------------------------------------------------
807   !!                 *** ROUTINE Agrif_get_proc_info ***
808   !!----------------------------------------------------------------------
809   USE par_oce
810   IMPLICIT NONE
811   !
812   INTEGER, INTENT(out) :: imin, imax
813   INTEGER, INTENT(out) :: jmin, jmax
814   !!----------------------------------------------------------------------
815   !
816   imin = nimppt(Agrif_Procrank+1)  ! ?????
817   jmin = njmppt(Agrif_Procrank+1)  ! ?????
818   imax = imin + jpi - 1
819   jmax = jmin + jpj - 1
820   !
821END SUBROUTINE Agrif_get_proc_info
822
823SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
824   !!----------------------------------------------------------------------
825   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
826   !!----------------------------------------------------------------------
827   USE par_oce
828   IMPLICIT NONE
829   !
830   INTEGER,  INTENT(in)  :: imin, imax
831   INTEGER,  INTENT(in)  :: jmin, jmax
832   INTEGER,  INTENT(in)  :: nbprocs
833   REAL(wp), INTENT(out) :: grid_cost
834   !!----------------------------------------------------------------------
835   !
836   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
837   !
838END SUBROUTINE Agrif_estimate_parallel_cost
839
840# endif
841
842#else
843SUBROUTINE Subcalledbyagrif
844   !!----------------------------------------------------------------------
845   !!                   *** ROUTINE Subcalledbyagrif ***
846   !!----------------------------------------------------------------------
847   WRITE(*,*) 'Impossible to be here'
848END SUBROUTINE Subcalledbyagrif
849#endif
Note: See TracBrowser for help on using the repository browser.