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

source: branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 8879

Last change on this file since 8879 was 8879, checked in by frrh, 6 years ago

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