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_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/NST – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/NST/agrif_user.F90 @ 11047

Last change on this file since 11047 was 11047, checked in by acc, 5 years ago

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