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

source: NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/NST/agrif_user.F90 @ 10009

Last change on this file since 10009 was 10009, checked in by gm, 6 years ago

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