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

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/NST/agrif_user.F90 @ 11463

Last change on this file since 11463 was 11053, checked in by davestorkey, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap : Merge in latest changes from main branch and finish conversion of "h" variables. NB. This version still doesn't work!

  • 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.