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 @ 10989

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

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