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 branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 8866

Last change on this file since 8866 was 8586, checked in by gm, 7 years ago

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