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

source: branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 8278

Last change on this file since 8278 was 6929, checked in by timgraham, 8 years ago

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