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 NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST – NEMO

source: NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_user.F90 @ 11205

Last change on this file since 11205 was 11205, checked in by jchanut, 5 years ago

#2199
1) Make sponge independent of sub-domain size. Partially masked open boundary segments are not taken into account anymore. To do so, sponge coefficients should be read in a file for realistic applications (then nesting tools need to be modified accordingly).
2) Replace East-West-North-South barotropic data arrays by a global 2d array. Then apply barotropic open boundary conditions thanks to mi0/mi1, mj0/mj1 indexes.
3) Call AGRIF bdy update one more time in dynspg_ts during extrapolation phase. This removes a dozen lines of code in dynspg_ts routine.

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