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/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2015/dev_r5847_MERCATOR9_solveur_simplification/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 5868

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

Free surface simplification #1620. Step 1: suppress filtered free surface

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