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/trunk/src/NST – NEMO

source: NEMO/trunk/src/NST/agrif_user.F90 @ 12138

Last change on this file since 12138 was 12138, checked in by smasson, 4 years ago

trunk: minor AGRIF bugfix, see #2322

  • Property svn:keywords set to Id
File size: 34.8 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_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 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_w(:,:) = 0.e0 ; vbdy_w(:,:) = 0.e0
202      ubdy_e(:,:) = 0.e0 ; vbdy_e(:,:) = 0.e0
203      ubdy_n(:,:) = 0.e0 ; vbdy_n(:,:) = 0.e0
204      ubdy_s(:,:) = 0.e0 ; vbdy_s(:,:) = 0.e0
205   ENDIF
206
207   Agrif_UseSpecialValue = .FALSE. 
208   ! reset velocities to zero
209   ua(:,:,:) = 0.
210   va(:,:,:) = 0.
211
212   ! 3. Some controls
213   !-----------------
214   check_namelist = .TRUE.
215
216   IF( check_namelist ) THEN 
217
218      ! Check time steps           
219      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
220         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
221         WRITE(cl_check2,*)  NINT(rdt)
222         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
223         CALL ctl_stop( 'Incompatible time step between ocean grids',   &
224               &               'parent grid value : '//cl_check1    ,   & 
225               &               'child  grid value : '//cl_check2    ,   & 
226               &               'value on child grid should be changed to : '//cl_check3 )
227      ENDIF
228
229      ! Check run length
230      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
231            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
232         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
233         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
234         CALL ctl_warn( 'Incompatible run length between grids'                      ,   &
235               &               'nit000 on fine grid will be changed to : '//cl_check1,   &
236               &               'nitend on fine grid will be changed to : '//cl_check2    )
237         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
238         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
239      ENDIF
240
241      ! Check free surface scheme
242      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
243         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
244         WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts )
245         WRITE(cl_check2,*)  ln_dynspg_ts
246         WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp )
247         WRITE(cl_check4,*)  ln_dynspg_exp
248         CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  &
249               &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  & 
250               &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  &
251               &               'parent grid ln_dynspg_exp :'//cl_check3  ,  &
252               &               'child  grid ln_dynspg_exp :'//cl_check4  ,  &
253               &               'those logicals should be identical' )                 
254         STOP
255      ENDIF
256
257      ! Check if identical linear free surface option
258      IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
259         & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
260         WRITE(cl_check1,*)  Agrif_Parent(ln_linssh )
261         WRITE(cl_check2,*)  ln_linssh
262         CALL ctl_stop( 'Incompatible linearized fs option between grids',  &
263               &               'parent grid ln_linssh  :'//cl_check1     ,  &
264               &               'child  grid ln_linssh  :'//cl_check2     ,  &
265               &               'those logicals should be identical' )                 
266         STOP
267      ENDIF
268
269      ! check if masks and bathymetries match
270      IF(ln_chk_bathy) THEN
271         !
272         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
273         !
274         kindic_agr = 0
275         ! check if umask agree with parent along western and eastern boundaries:
276         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
277         ! check if vmask agree with parent along northern and southern boundaries:
278         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
279         ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
280         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
281         !
282         CALL mpp_sum( 'agrif_user', kindic_agr )
283         IF( kindic_agr /= 0 ) THEN
284            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
285         ELSE
286            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
287         END IF
288      ENDIF
289      !
290   ENDIF
291   !
292END SUBROUTINE Agrif_InitValues_cont
293
294SUBROUTINE agrif_declare_var
295      !!----------------------------------------------------------------------
296      !!                 *** ROUTINE agrif_declarE_var ***
297      !!
298      !! ** Purpose :: Declaration of variables to be interpolated
299      !!----------------------------------------------------------------------
300   USE agrif_util
301   USE agrif_oce
302   USE par_oce       ! ocean parameters
303   USE zdf_oce       ! vertical physics
304   USE oce
305   !
306   IMPLICIT NONE
307   !
308   INTEGER :: ind1, ind2, ind3
309      !!----------------------------------------------------------------------
310
311   ! 1. Declaration of the type of variable which have to be interpolated
312   !---------------------------------------------------------------------
313   ind1 =     nbghostcells
314   ind2 = 1 + nbghostcells
315   ind3 = 2 + nbghostcells
316# if defined key_vertical
317   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)
318   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)
319
320   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)
321   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)
322   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)
323   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)
324   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)
325   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)
326# else
327   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)
328   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)
329
330   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)
331   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)
332   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)
333   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)
334   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)
335   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)
336# endif
337
338   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
339   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
340   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
341
342   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)
343
344   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
345   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
346   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
347   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
348   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
349   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
350
351   CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
352
353   IF( ln_zdftke.OR.ln_zdfgls ) THEN
354!      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id)
355!      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id)
356# if defined key_vertical
357      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)
358# else
359      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)
360# endif
361   ENDIF
362
363   ! 2. Type of interpolation
364   !-------------------------
365   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
366
367   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
368   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
369
370   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
371
372   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
373   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
374   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
375   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
376   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
377
378
379   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
380   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
381
382   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
383   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
384   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
385
386   IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
387
388   ! 3. Location of interpolation
389   !-----------------------------
390   CALL Agrif_Set_bc(       tsn_id, (/0,ind1/) )
391   CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) )
392   CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) )
393
394   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
395   CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
396   CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
397
398   CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) )
399   CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) )
400   CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) )
401   CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
402   CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
403
404   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
405   CALL Agrif_Set_bc( umsk_id, (/0,0/) )
406   CALL Agrif_Set_bc( vmsk_id, (/0,0/) )
407
408
409   IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
410
411   ! 4. Update type
412   !---------------
413   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
414
415# if defined UPD_HIGH
416   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
417   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
418   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
419
420   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
421   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
422   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
423   CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
424
425   IF( ln_zdftke.OR.ln_zdfgls ) THEN
426!      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
427!      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
428!      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
429   ENDIF
430
431#else
432   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
433   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
434   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
435
436   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
437   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
438   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
439   CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
440
441   IF( ln_zdftke.OR.ln_zdfgls ) THEN
442!      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
443!      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
444!      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
445   ENDIF
446
447#endif
448   !
449END SUBROUTINE agrif_declare_var
450
451#if defined key_si3
452SUBROUTINE Agrif_InitValues_cont_ice
453      !!----------------------------------------------------------------------
454      !!                 *** ROUTINE Agrif_InitValues_cont_ice ***
455      !!
456      !! ** Purpose :: Initialisation of variables to be interpolated for ice
457      !!----------------------------------------------------------------------
458   USE Agrif_Util
459   USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
460   USE ice
461   USE agrif_ice
462   USE in_out_manager
463   USE agrif_ice_interp
464   USE lib_mpp
465   !
466   IMPLICIT NONE
467      !!----------------------------------------------------------------------
468   !
469   ! Declaration of the type of variable which have to be interpolated (parent=>child)
470   !----------------------------------------------------------------------------------
471   CALL agrif_declare_var_ice
472
473   ! Controls
474
475   ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
476   !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
477   !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
478   !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
479   IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
480
481   ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
482   IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
483      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
484   ENDIF
485   ! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
486   !----------------------------------------------------------------------
487   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)
488   CALL agrif_interp_ice('U') ! interpolation of ice velocities
489   CALL agrif_interp_ice('V') ! interpolation of ice velocities
490   CALL agrif_interp_ice('T') ! interpolation of ice tracers
491   nbstep_ice = 0
492   
493   !
494END SUBROUTINE Agrif_InitValues_cont_ice
495
496SUBROUTINE agrif_declare_var_ice
497      !!----------------------------------------------------------------------
498      !!                 *** ROUTINE agrif_declare_var_ice ***
499      !!
500      !! ** Purpose :: Declaration of variables to be interpolated for ice
501      !!----------------------------------------------------------------------
502   USE Agrif_Util
503   USE ice
504   USE par_oce, ONLY : nbghostcells
505   !
506   IMPLICIT NONE
507   !
508   INTEGER :: ind1, ind2, ind3
509      !!----------------------------------------------------------------------
510   !
511   ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
512   !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
513   !           ex.:  position=> 1,1 = not-centered (in i and j)
514   !                            2,2 =     centered (    -     )
515   !                 index   => 1,1 = one ghost line
516   !                            2,2 = two ghost lines
517   !-------------------------------------------------------------------------------------
518   ind1 =     nbghostcells
519   ind2 = 1 + nbghostcells
520   ind3 = 2 + nbghostcells
521   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)
522   CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  )
523   CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  )
524
525   ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
526   !-----------------------------------
527   CALL Agrif_Set_bcinterp(tra_ice_id, interp  = AGRIF_linear)
528   CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
529   CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
530
531   ! 3. Set location of interpolations
532   !----------------------------------
533   CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
534   CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
535   CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
536
537   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
538   !--------------------------------------------------
539# if defined UPD_HIGH
540   CALL Agrif_Set_Updatetype(tra_ice_id, update  = Agrif_Update_Full_Weighting)
541   CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
542   CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
543#else
544   CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average)
545   CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
546   CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
547#endif
548
549END SUBROUTINE agrif_declare_var_ice
550#endif
551
552
553# if defined key_top
554SUBROUTINE Agrif_InitValues_cont_top
555      !!----------------------------------------------------------------------
556      !!                 *** ROUTINE Agrif_InitValues_cont_top ***
557      !!
558      !! ** Purpose :: Declaration of variables to be interpolated
559      !!----------------------------------------------------------------------
560   USE Agrif_Util
561   USE oce 
562   USE dom_oce
563   USE nemogcm
564   USE par_trc
565   USE lib_mpp
566   USE trc
567   USE in_out_manager
568   USE agrif_oce_sponge
569   USE agrif_top_update
570   USE agrif_top_interp
571   USE agrif_top_sponge
572   !!
573   IMPLICIT NONE
574   !
575   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
576   LOGICAL :: check_namelist
577      !!----------------------------------------------------------------------
578
579
580   ! 1. Declaration of the type of variable which have to be interpolated
581   !---------------------------------------------------------------------
582   CALL agrif_declare_var_top
583
584   ! 2. First interpolations of potentially non zero fields
585   !-------------------------------------------------------
586   Agrif_SpecialValue=0.
587   Agrif_UseSpecialValue = .TRUE.
588   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
589   Agrif_UseSpecialValue = .FALSE.
590   CALL Agrif_Sponge
591   tabspongedone_trn = .FALSE.
592   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
593   ! reset tsa to zero
594   tra(:,:,:,:) = 0.
595
596
597   ! 3. Some controls
598   !-----------------
599   check_namelist = .TRUE.
600
601   IF( check_namelist ) THEN
602      ! Check time steps
603      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
604         WRITE(cl_check1,*)  Agrif_Parent(rdt)
605         WRITE(cl_check2,*)  rdt
606         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
607         CALL ctl_stop( 'incompatible time step between grids',   &
608               &               'parent grid value : '//cl_check1    ,   & 
609               &               'child  grid value : '//cl_check2    ,   & 
610               &               'value on child grid should be changed to  &
611               &               :'//cl_check3  )
612      ENDIF
613
614      ! Check run length
615      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
616            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
617         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
618         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
619         CALL ctl_warn( 'incompatible run length between grids'               ,   &
620               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
621               &              ' nitend on fine grid will be change to : '//cl_check2    )
622         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
623         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
624      ENDIF
625
626      ! Check passive tracer cell
627      IF( nn_dttrc .NE. 1 ) THEN
628         WRITE(*,*) 'nn_dttrc should be equal to 1'
629      ENDIF
630   ENDIF
631   !
632END SUBROUTINE Agrif_InitValues_cont_top
633
634
635SUBROUTINE agrif_declare_var_top
636      !!----------------------------------------------------------------------
637      !!                 *** ROUTINE agrif_declare_var_top ***
638      !!
639      !! ** Purpose :: Declaration of TOP variables to be interpolated
640      !!----------------------------------------------------------------------
641   USE agrif_util
642   USE agrif_oce
643   USE dom_oce
644   USE trc
645   !!
646   IMPLICIT NONE
647   !
648   INTEGER :: ind1, ind2, ind3
649      !!----------------------------------------------------------------------
650
651   ! 1. Declaration of the type of variable which have to be interpolated
652   !---------------------------------------------------------------------
653   ind1 =     nbghostcells
654   ind2 = 1 + nbghostcells
655   ind3 = 2 + nbghostcells
656# if defined key_vertical
657   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)
658   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)
659# else
660   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)
661   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)
662# endif
663
664   ! 2. Type of interpolation
665   !-------------------------
666   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
667   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
668
669   ! 3. Location of interpolation
670   !-----------------------------
671   CALL Agrif_Set_bc(trn_id,(/0,ind1/))
672   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
673
674   ! 4. Update type
675   !---------------
676# if defined UPD_HIGH
677   CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
678#else
679   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
680#endif
681   !
682END SUBROUTINE agrif_declare_var_top
683# endif
684
685SUBROUTINE Agrif_detect( kg, ksizex )
686      !!----------------------------------------------------------------------
687      !!                      *** ROUTINE Agrif_detect ***
688      !!----------------------------------------------------------------------
689   INTEGER, DIMENSION(2) :: ksizex
690   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
691      !!----------------------------------------------------------------------
692   !
693   RETURN
694   !
695END SUBROUTINE Agrif_detect
696
697
698SUBROUTINE agrif_nemo_init
699      !!----------------------------------------------------------------------
700      !!                     *** ROUTINE agrif_init ***
701      !!----------------------------------------------------------------------
702   USE agrif_oce 
703   USE agrif_ice
704   USE in_out_manager
705   USE lib_mpp
706   !!
707   IMPLICIT NONE
708   !
709   INTEGER  ::   ios                 ! Local integer output status for namelist read
710   INTEGER  ::   iminspon
711   NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
712      !!--------------------------------------------------------------------------------------
713   !
714   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
715   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
716901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist' )
717   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
718   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
719902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
720   IF(lwm) WRITE ( numond, namagrif )
721   !
722   IF(lwp) THEN                    ! control print
723      WRITE(numout,*)
724      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
725      WRITE(numout,*) '~~~~~~~~~~~~~~~'
726      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
727      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
728      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
729      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
730      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
731   ENDIF
732   !
733   ! convert DOCTOR namelist name into OLD names
734   visc_tra      = rn_sponge_tra
735   visc_dyn      = rn_sponge_dyn
736   !
737   ! Check sponge length:
738   IF(     MIN(jpi   ,jpj   ) <=     1 + nbghostcells + (nn_sponge_len * Agrif_irhox() + 1)     &
739      .OR. MIN(jpiglo,jpjglo) <= 2* (1 + nbghostcells + (nn_sponge_len * Agrif_irhox() + 1) ) ) &
740      &     CALL ctl_stop('STOP','agrif sponge length is too large')
741   !
742   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
743   !
744END SUBROUTINE agrif_nemo_init
745
746# if defined key_mpp_mpi
747
748SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
749      !!----------------------------------------------------------------------
750      !!                     *** ROUTINE Agrif_InvLoc ***
751      !!----------------------------------------------------------------------
752   USE dom_oce
753   !!
754   IMPLICIT NONE
755   !
756   INTEGER :: indglob, indloc, nprocloc, i
757      !!----------------------------------------------------------------------
758   !
759   SELECT CASE( i )
760   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
761   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
762   CASE DEFAULT
763      indglob = indloc
764   END SELECT
765   !
766END SUBROUTINE Agrif_InvLoc
767
768
769SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
770      !!----------------------------------------------------------------------
771      !!                 *** ROUTINE Agrif_get_proc_info ***
772      !!----------------------------------------------------------------------
773   USE par_oce
774   !!
775   IMPLICIT NONE
776   !
777   INTEGER, INTENT(out) :: imin, imax
778   INTEGER, INTENT(out) :: jmin, jmax
779      !!----------------------------------------------------------------------
780   !
781   imin = nimppt(Agrif_Procrank+1)  ! ?????
782   jmin = njmppt(Agrif_Procrank+1)  ! ?????
783   imax = imin + jpi - 1
784   jmax = jmin + jpj - 1
785   !
786END SUBROUTINE Agrif_get_proc_info
787
788
789SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
790      !!----------------------------------------------------------------------
791      !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
792      !!----------------------------------------------------------------------
793   USE par_oce
794   !!
795   IMPLICIT NONE
796   !
797   INTEGER,  INTENT(in)  :: imin, imax
798   INTEGER,  INTENT(in)  :: jmin, jmax
799   INTEGER,  INTENT(in)  :: nbprocs
800   REAL(wp), INTENT(out) :: grid_cost
801      !!----------------------------------------------------------------------
802   !
803   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
804   !
805END SUBROUTINE Agrif_estimate_parallel_cost
806
807# endif
808
809#else
810SUBROUTINE Subcalledbyagrif
811      !!----------------------------------------------------------------------
812      !!                   *** ROUTINE Subcalledbyagrif ***
813      !!----------------------------------------------------------------------
814   WRITE(*,*) 'Impossible to be here'
815END SUBROUTINE Subcalledbyagrif
816#endif
Note: See TracBrowser for help on using the repository browser.