New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
agrif_user.F90 in branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 7972

Last change on this file since 7972 was 7972, checked in by jchanut, 8 years ago

Add ssh bc with Agrif
  • Property svn:keywords set to Id
File size: 32.6 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 sol_oce
107   USE in_out_manager
108   USE agrif_opa_update
109   USE agrif_opa_interp
110   USE agrif_opa_sponge
111   !
112   IMPLICIT NONE
113   !
114   !!----------------------------------------------------------------------
115
116   ! Declaration of the type of variable which have to be interpolated
117   !---------------------------------------------------------------------
118   CALL agrif_declare_var_dom
119   !
120END SUBROUTINE Agrif_InitValues_cont_dom
121
122
123SUBROUTINE agrif_declare_var_dom
124   !!----------------------------------------------------------------------
125   !!                 *** ROUTINE agrif_declare_var ***
126   !!
127   !! ** Purpose :: Declaration of variables to be interpolated
128   !!----------------------------------------------------------------------
129   USE agrif_util
130   USE par_oce       
131   USE oce
132   IMPLICIT NONE
133   !!----------------------------------------------------------------------
134
135   ! 1. Declaration of the type of variable which have to be interpolated
136   !---------------------------------------------------------------------
137   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
138   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
139
140   ! 2. Type of interpolation
141   !-------------------------
142   CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
143   CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
144
145   ! 3. Location of interpolation
146   !-----------------------------
147   CALL Agrif_Set_bc(e1u_id,(/0,0/))
148   CALL Agrif_Set_bc(e2v_id,(/0,0/))
149
150   ! 5. Update type
151   !---------------
152   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
153   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
154
155! High order updates
156!   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting)
157!   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average)
158    !
159END SUBROUTINE agrif_declare_var_dom
160
161
162# if ! defined key_offline
163
164SUBROUTINE Agrif_InitValues_cont
165   !!----------------------------------------------------------------------
166   !!                 *** ROUTINE Agrif_InitValues_cont ***
167   !!
168   !! ** Purpose ::   Declaration of variables to be interpolated
169   !!----------------------------------------------------------------------
170   USE Agrif_Util
171   USE oce 
172   USE dom_oce
173   USE nemogcm
174   USE sol_oce
175   USE lib_mpp
176   USE in_out_manager
177   USE agrif_opa_update
178   USE agrif_opa_interp
179   USE agrif_opa_sponge
180   !
181   IMPLICIT NONE
182   !
183   LOGICAL :: check_namelist
184   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3
185   !!----------------------------------------------------------------------
186
187   ! 1. Declaration of the type of variable which have to be interpolated
188   !---------------------------------------------------------------------
189   CALL agrif_declare_var
190
191   ! 2. First interpolations of potentially non zero fields
192   !-------------------------------------------------------
193   Agrif_SpecialValue=0.
194   Agrif_UseSpecialValue = .TRUE.
195   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
196   CALL Agrif_Sponge
197   tabspongedone_tsn = .FALSE.
198   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
199   ! reset tsa to zero
200   tsa(:,:,:,:) = 0.
201
202   Agrif_UseSpecialValue = ln_spc_dyn
203   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
204   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
205   tabspongedone_u = .FALSE.
206   tabspongedone_v = .FALSE.
207   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
208   tabspongedone_u = .FALSE.
209   tabspongedone_v = .FALSE.
210   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
211
212   Agrif_UseSpecialValue = .TRUE.
213   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
214
215#if defined key_dynspg_ts
216   Agrif_UseSpecialValue = ln_spc_dyn
217   CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
218   CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
219   CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
220   CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
221   ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0
222   ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 
223   ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 
224   ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0
225#endif
226
227   Agrif_UseSpecialValue = .FALSE. 
228   ! reset velocities to zero
229   ua(:,:,:) = 0.
230   va(:,:,:) = 0.
231
232   ! 3. Some controls
233   !-----------------
234   check_namelist = .TRUE.
235
236   IF( check_namelist ) THEN 
237
238      ! Check time steps           
239      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
240         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
241         WRITE(cl_check2,*)  NINT(rdt)
242         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
243         CALL ctl_warn( 'incompatible time step between grids',   &
244               &               'parent grid value : '//cl_check1    ,   & 
245               &               'child  grid value : '//cl_check2    ,   & 
246               &               'value on child grid will be changed to : '//cl_check3 )
247         rdt=Agrif_Parent(rdt)/Agrif_Rhot()
248      ENDIF
249
250      ! Check run length
251      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
252            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
253         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
254         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
255         CALL ctl_warn( 'incompatible run length between grids'               ,   &
256               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
257               &              ' nitend on fine grid will be change to : '//cl_check2    )
258         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
259         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
260      ENDIF
261
262      ! Check coordinates
263      IF( ln_zps ) THEN
264         ! check parameters for partial steps
265         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
266            WRITE(*,*) 'incompatible e3zps_min between grids'
267            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
268            WRITE(*,*) 'child grid  :',e3zps_min
269            WRITE(*,*) 'those values should be identical'
270            STOP
271         ENDIF
272         IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
273            WRITE(*,*) 'incompatible e3zps_rat between grids'
274            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
275            WRITE(*,*) 'child grid  :',e3zps_rat
276            WRITE(*,*) 'those values should be identical'                 
277            STOP
278         ENDIF
279      ENDIF
280      ! check if masks and bathymetries match
281      IF(ln_chk_bathy) THEN
282         !
283         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
284         !
285         kindic_agr = 0
286         ! check if umask agree with parent along western and eastern boundaries:
287         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
288         ! check if vmask agree with parent along northern and southern boundaries:
289         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
290    ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
291         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
292         !
293         IF (lk_mpp) CALL mpp_sum( kindic_agr )
294         IF( kindic_agr /= 0 ) THEN                   
295            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
296         ELSE
297            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
298         END IF
299      ENDIF
300      !
301   ENDIF
302   !
303   ! Do update at initialisation because not done before writing restarts
304   ! This would indeed change boundary conditions values at initial time
305   ! hence produce restartability issues.
306   ! Note that update below is recursive (with lk_agrif_doupd=T):
307   !
308! JC: I am not sure if Agrif_MaxLevel() is the "relative"
309!     or the absolute maximum nesting level...TBC                       
310   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 
311      ! NB: Order matters below:
312      CALL Agrif_Update_vvl() 
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   CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
450
451! High order updates
452!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
453!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
454!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
455!
456!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
457!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
458!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
459 
460   !
461END SUBROUTINE agrif_declare_var
462# endif
463
464#  if defined key_lim2
465SUBROUTINE Agrif_InitValues_cont_lim2
466   !!----------------------------------------------------------------------
467   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 ***
468   !!
469   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2
470   !!----------------------------------------------------------------------
471   USE Agrif_Util
472   USE ice_2
473   USE agrif_ice
474   USE in_out_manager
475   USE agrif_lim2_update
476   USE agrif_lim2_interp
477   USE lib_mpp
478   !
479   IMPLICIT NONE
480   !
481   !!----------------------------------------------------------------------
482
483   ! 1. Declaration of the type of variable which have to be interpolated
484   !---------------------------------------------------------------------
485   CALL agrif_declare_var_lim2
486
487   ! 2. First interpolations of potentially non zero fields
488   !-------------------------------------------------------
489   Agrif_SpecialValue=-9999.
490   Agrif_UseSpecialValue = .TRUE.
491   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )
492   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   )
493   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   )
494   Agrif_SpecialValue=0.
495   Agrif_UseSpecialValue = .FALSE.
496
497   ! 3. Some controls
498   !-----------------
499
500#   if ! defined key_lim2_vp
501   lim_nbstep = 1.
502   CALL agrif_rhg_lim2_load
503   CALL agrif_trp_lim2_load
504   lim_nbstep = 0.
505#   endif
506   !RB mandatory but why ???
507   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN
508   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')
509   !         nbclineupdate = nn_fsbc
510   !       ENDIF
511   CALL Agrif_Update_lim2(0)
512   !
513END SUBROUTINE Agrif_InitValues_cont_lim2
514
515SUBROUTINE agrif_declare_var_lim2
516   !!----------------------------------------------------------------------
517   !!                 *** ROUTINE agrif_declare_var_lim2 ***
518   !!
519   !! ** Purpose :: Declaration of variables to be interpolated for LIM2
520   !!----------------------------------------------------------------------
521   USE agrif_util
522   USE ice_2
523
524   IMPLICIT NONE
525   !!----------------------------------------------------------------------
526
527   ! 1. Declaration of the type of variable which have to be interpolated
528   !---------------------------------------------------------------------
529   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )
530#   if defined key_lim2_vp
531   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
532   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
533#   else
534   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
535   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
536#   endif
537
538   ! 2. Type of interpolation
539   !-------------------------
540   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
541   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
542   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
543
544   ! 3. Location of interpolation
545   !-----------------------------
546   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))
547   CALL Agrif_Set_bc(u_ice_id,(/0,1/))
548   CALL Agrif_Set_bc(v_ice_id,(/0,1/))
549
550   ! 5. Update type
551   !---------------
552   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
553   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
554   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
555   !
556END SUBROUTINE agrif_declare_var_lim2
557#  endif
558
559
560# if defined key_top
561SUBROUTINE Agrif_InitValues_cont_top
562   !!----------------------------------------------------------------------
563   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
564   !!
565   !! ** Purpose :: Declaration of variables to be interpolated
566   !!----------------------------------------------------------------------
567   USE Agrif_Util
568   USE oce 
569   USE dom_oce
570   USE nemogcm
571   USE par_trc
572   USE lib_mpp
573   USE trc
574   USE in_out_manager
575   USE agrif_opa_sponge
576   USE agrif_top_update
577   USE agrif_top_interp
578   USE agrif_top_sponge
579   !
580   IMPLICIT NONE
581   !
582   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
583   LOGICAL :: check_namelist
584   !!----------------------------------------------------------------------
585
586
587   ! 1. Declaration of the type of variable which have to be interpolated
588   !---------------------------------------------------------------------
589   CALL agrif_declare_var_top
590
591   ! 2. First interpolations of potentially non zero fields
592   !-------------------------------------------------------
593   Agrif_SpecialValue=0.
594   Agrif_UseSpecialValue = .TRUE.
595   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
596   Agrif_UseSpecialValue = .FALSE.
597   CALL Agrif_Sponge
598   tabspongedone_trn = .FALSE.
599   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
600   ! reset tsa to zero
601   tra(:,:,:,:) = 0.
602
603
604   ! 3. Some controls
605   !-----------------
606   check_namelist = .TRUE.
607
608   IF( check_namelist ) THEN
609# if defined key_offline
610      ! Check time steps
611      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
612         WRITE(cl_check1,*)  Agrif_Parent(rdt)
613         WRITE(cl_check2,*)  rdt
614         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
615         CALL ctl_warn( 'incompatible time step between grids',   &
616               &               'parent grid value : '//cl_check1    ,   & 
617               &               'child  grid value : '//cl_check2    ,   & 
618               &               'value on child grid will be changed to  &
619               &               :'//cl_check3  )
620         rdt=rdt*Agrif_Rhot()
621      ENDIF
622
623      ! Check run length
624      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
625            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
626         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
627         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
628         CALL ctl_warn( 'incompatible run length between grids'               ,   &
629               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
630               &              ' nitend on fine grid will be change to : '//cl_check2    )
631         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
632         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
633      ENDIF
634
635      ! Check coordinates
636      IF( ln_zps ) THEN
637         ! check parameters for partial steps
638         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
639            WRITE(*,*) 'incompatible e3zps_min between grids'
640            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
641            WRITE(*,*) 'child grid  :',e3zps_min
642            WRITE(*,*) 'those values should be identical'
643            STOP
644         ENDIF
645         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN
646            WRITE(*,*) 'incompatible e3zps_rat between grids'
647            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
648            WRITE(*,*) 'child grid  :',e3zps_rat
649            WRITE(*,*) 'those values should be identical'                 
650            STOP
651         ENDIF
652      ENDIF
653#  endif         
654      ! Check passive tracer cell
655      IF( nn_dttrc .NE. 1 ) THEN
656         WRITE(*,*) 'nn_dttrc should be equal to 1'
657      ENDIF
658   ENDIF
659
660   CALL Agrif_Update_trc(0)
661   !
662   Agrif_UseSpecialValueInUpdate = .FALSE.
663   nbcline_trc = 0
664   !
665END SUBROUTINE Agrif_InitValues_cont_top
666
667
668SUBROUTINE agrif_declare_var_top
669   !!----------------------------------------------------------------------
670   !!                 *** ROUTINE agrif_declare_var_top ***
671   !!
672   !! ** Purpose :: Declaration of TOP variables to be interpolated
673   !!----------------------------------------------------------------------
674   USE agrif_util
675   USE agrif_oce
676   USE dom_oce
677   USE trc
678
679   IMPLICIT NONE
680
681   ! 1. Declaration of the type of variable which have to be interpolated
682   !---------------------------------------------------------------------
683   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)
684   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)
685
686   ! 2. Type of interpolation
687   !-------------------------
688   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
689   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
690
691   ! 3. Location of interpolation
692   !-----------------------------
693   CALL Agrif_Set_bc(trn_id,(/0,1/))
694!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))
695   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
696
697   ! 5. Update type
698   !---------------
699   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
700
701!   Higher order update
702!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
703
704   !
705END SUBROUTINE agrif_declare_var_top
706# endif
707
708SUBROUTINE Agrif_detect( kg, ksizex )
709   !!----------------------------------------------------------------------
710   !!   *** ROUTINE Agrif_detect ***
711   !!----------------------------------------------------------------------
712   !
713   INTEGER, DIMENSION(2) :: ksizex
714   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
715   !!----------------------------------------------------------------------
716   !
717   RETURN
718   !
719END SUBROUTINE Agrif_detect
720
721
722SUBROUTINE agrif_nemo_init
723   !!----------------------------------------------------------------------
724   !!                     *** ROUTINE agrif_init ***
725   !!----------------------------------------------------------------------
726   USE agrif_oce 
727   USE agrif_ice
728   USE in_out_manager
729   USE lib_mpp
730   IMPLICIT NONE
731   !
732   INTEGER  ::   ios                 ! Local integer output status for namelist read
733   INTEGER  ::   iminspon
734   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
735   !!--------------------------------------------------------------------------------------
736   !
737   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
738   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
739901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
740
741   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
742   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
743902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
744   IF(lwm) WRITE ( numond, namagrif )
745   !
746   IF(lwp) THEN                    ! control print
747      WRITE(numout,*)
748      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
749      WRITE(numout,*) '~~~~~~~~~~~~~~~'
750      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
751      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
752      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
753      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
754      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
755      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
756      WRITE(numout,*) 
757   ENDIF
758   !
759   ! convert DOCTOR namelist name into OLD names
760   nbclineupdate = nn_cln_update
761   visc_tra      = rn_sponge_tra
762   visc_dyn      = rn_sponge_dyn
763   !
764   ! Check sponge length:
765   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
766   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
767   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
768   !
769   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
770# if defined key_lim2
771   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed')
772# endif
773   !
774END SUBROUTINE agrif_nemo_init
775
776# if defined key_mpp_mpi
777
778SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
779   !!----------------------------------------------------------------------
780   !!                     *** ROUTINE Agrif_detect ***
781   !!----------------------------------------------------------------------
782   USE dom_oce
783   IMPLICIT NONE
784   !
785   INTEGER :: indglob, indloc, nprocloc, i
786   !!----------------------------------------------------------------------
787   !
788   SELECT CASE( i )
789   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
790   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
791   CASE DEFAULT
792      indglob = indloc
793   END SELECT
794   !
795END SUBROUTINE Agrif_InvLoc
796
797SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
798   !!----------------------------------------------------------------------
799   !!                 *** ROUTINE Agrif_get_proc_info ***
800   !!----------------------------------------------------------------------
801   USE par_oce
802   IMPLICIT NONE
803   !
804   INTEGER, INTENT(out) :: imin, imax
805   INTEGER, INTENT(out) :: jmin, jmax
806   !!----------------------------------------------------------------------
807   !
808   imin = nimppt(Agrif_Procrank+1)  ! ?????
809   jmin = njmppt(Agrif_Procrank+1)  ! ?????
810   imax = imin + jpi - 1
811   jmax = jmin + jpj - 1
812   !
813END SUBROUTINE Agrif_get_proc_info
814
815SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
816   !!----------------------------------------------------------------------
817   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
818   !!----------------------------------------------------------------------
819   USE par_oce
820   IMPLICIT NONE
821   !
822   INTEGER,  INTENT(in)  :: imin, imax
823   INTEGER,  INTENT(in)  :: jmin, jmax
824   INTEGER,  INTENT(in)  :: nbprocs
825   REAL(wp), INTENT(out) :: grid_cost
826   !!----------------------------------------------------------------------
827   !
828   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
829   !
830END SUBROUTINE Agrif_estimate_parallel_cost
831
832# endif
833
834#else
835SUBROUTINE Subcalledbyagrif
836   !!----------------------------------------------------------------------
837   !!                   *** ROUTINE Subcalledbyagrif ***
838   !!----------------------------------------------------------------------
839   WRITE(*,*) 'Impossible to be here'
840END SUBROUTINE Subcalledbyagrif
841#endif
Note: See TracBrowser for help on using the repository browser.