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_CNRS_2017/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 9012

Last change on this file since 9012 was 9012, checked in by acc, 6 years ago

Branch dev_CNRS_2017. Merge in no_ghost changes from dev_r8126_ROBUST08_no_ghost. These changes include lib_mpp refresh and rationalisation of mppini from dev_r8126_ROBUST10_MPPINI
  • Property svn:keywords set to Id
File size: 35.0 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*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls
31      jpj     = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls
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   Agrif_UseSpecialValueInUpdate = .FALSE.
329   nbcline = 0
330   lk_agrif_doupd = .FALSE.
331   !
332END SUBROUTINE Agrif_InitValues_cont
333
334
335SUBROUTINE agrif_declare_var
336   !!----------------------------------------------------------------------
337   !!                 *** ROUTINE agrif_declarE_var ***
338   !!
339   !! ** Purpose :: Declaration of variables to be interpolated
340   !!----------------------------------------------------------------------
341   USE agrif_util
342   USE agrif_oce
343   USE par_oce       ! ocean parameters
344   USE zdf_oce       ! vertical physics
345   USE oce
346   !
347   IMPLICIT NONE
348   !
349   INTEGER :: ind1, ind2, ind3
350   !!----------------------------------------------------------------------
351
352   ! 1. Declaration of the type of variable which have to be interpolated
353   !---------------------------------------------------------------------
354   ind1 =     nbghostcells
355   ind2 = 1 + nbghostcells
356   ind3 = 2 + nbghostcells
357   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)
358   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)
359
360   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
361   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
362   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
363   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
364   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
365   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
366
367   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
368   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
369   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
370
371   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)
372
373   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
374   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
375   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
376   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
377   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
378   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
379
380   CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
381
382   IF( ln_zdftke ) THEN
383      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
384      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
385      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
386   ENDIF
387
388   ! 2. Type of interpolation
389   !-------------------------
390   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
391
392   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
393   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
394
395   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
396
397   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
398   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
399   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
400   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
401   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
402
403
404   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
405   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
406
407   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
408   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
409   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
410
411   IF( ln_zdftke )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
412
413   ! 3. Location of interpolation
414   !-----------------------------
415   CALL Agrif_Set_bc(       tsn_id, (/0,ind1/) )
416   CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) )
417   CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) )
418
419   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
420   CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
421   CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
422
423   CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) )
424   CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) )
425   CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) )
426   CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
427   CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
428
429   CALL Agrif_Set_bc(  e3t_id, (/-2*Agrif_irhox()-1,ind1-1/) )   ! if west and rhox=3 and ghost=1: column 2 to 9
430   CALL Agrif_Set_bc( umsk_id, (/0,ind1-1/)                  )
431   CALL Agrif_Set_bc( vmsk_id, (/0,ind1-1/)                  )
432
433   IF( ln_zdftke )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
434
435   ! 5. Update type
436   !---------------
437   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
438
439   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
440
441   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
442   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
443
444   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
445
446   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
447   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
448
449   IF( ln_zdftke) THEN
450      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
451      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
452      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
453   ENDIF
454
455! High order updates
456!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
457!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
458!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
459!
460!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
461!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
462!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
463
464   !
465END SUBROUTINE agrif_declare_var
466
467#if defined key_lim3
468SUBROUTINE Agrif_InitValues_cont_lim3
469   !!----------------------------------------------------------------------
470   !!                 *** ROUTINE Agrif_InitValues_cont_lim3 ***
471   !!
472   !! ** Purpose :: Initialisation of variables to be interpolated for LIM3
473   !!----------------------------------------------------------------------
474   USE Agrif_Util
475   USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
476   USE ice
477   USE agrif_ice
478   USE in_out_manager
479   USE agrif_lim3_update
480   USE agrif_lim3_interp
481   USE lib_mpp
482   !
483   IMPLICIT NONE
484   !!----------------------------------------------------------------------
485   !
486   ! Declaration of the type of variable which have to be interpolated (parent=>child)
487   !----------------------------------------------------------------------------------
488   CALL agrif_declare_var_lim3
489
490   ! Controls
491
492   ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal is largely degraded by the agrif zoom)
493   !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
494   !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
495   !       If a solution is found, the following stop could be removed
496   IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and lim3 do not work properly')
497
498   ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
499   IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
500      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
501   ENDIF
502
503   ! stop if update frequency is different from nn_fsbc
504   IF( nbclineupdate > nn_fsbc )  CALL ctl_stop('With ice model on child grid, nn_cln_update should be set to 1 or nn_fsbc')
505
506
507   ! First Interpolations (using "after" ice subtime step => lim_nbstep=1)
508   !----------------------------------------------------------------------
509!!   lim_nbstep = 1
510   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)
511   CALL agrif_interp_lim3('U') ! interpolation of ice velocities
512   CALL agrif_interp_lim3('V') ! interpolation of ice velocities
513   CALL agrif_interp_lim3('T') ! interpolation of ice tracers
514   lim_nbstep = 0
515   
516   ! Update in case 2 ways
517   !----------------------
518   CALL agrif_update_lim3(0)
519
520   !
521END SUBROUTINE Agrif_InitValues_cont_lim3
522
523SUBROUTINE agrif_declare_var_lim3
524   !!----------------------------------------------------------------------
525   !!                 *** ROUTINE agrif_declare_var_lim3 ***
526   !!
527   !! ** Purpose :: Declaration of variables to be interpolated for LIM3
528   !!----------------------------------------------------------------------
529   USE Agrif_Util
530   USE ice
531   USE par_oce, ONLY : nbghostcells
532   !
533   IMPLICIT NONE
534   !
535   INTEGER :: ind1, ind2, ind3
536   !!----------------------------------------------------------------------
537   !
538   ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
539   !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
540   !           ex.:  position=> 1,1 = not-centered (in i and j)
541   !                            2,2 =     centered (    -     )
542   !                 index   => 1,1 = one ghost line
543   !                            2,2 = two ghost lines
544   !-------------------------------------------------------------------------------------
545   ind1 =     nbghostcells
546   ind2 = 1 + nbghostcells
547   ind3 = 2 + nbghostcells
548   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 )
549   CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
550   CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
551
552   ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
553   !-----------------------------------
554   CALL Agrif_Set_bcinterp(tra_ice_id,  interp = AGRIF_linear)
555   CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
556   CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
557
558   ! 3. Set location of interpolations
559   !----------------------------------
560   CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
561   CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
562   CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
563
564   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
565   !--------------------------------------------------
566   CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
567   CALL Agrif_Set_Updatetype(u_ice_id  ,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
568   CALL Agrif_Set_Updatetype(v_ice_id  ,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
569
570END SUBROUTINE agrif_declare_var_lim3
571#endif
572
573
574# if defined key_top
575SUBROUTINE Agrif_InitValues_cont_top
576   !!----------------------------------------------------------------------
577   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
578   !!
579   !! ** Purpose :: Declaration of variables to be interpolated
580   !!----------------------------------------------------------------------
581   USE Agrif_Util
582   USE oce 
583   USE dom_oce
584   USE nemogcm
585   USE par_trc
586   USE lib_mpp
587   USE trc
588   USE in_out_manager
589   USE agrif_opa_sponge
590   USE agrif_top_update
591   USE agrif_top_interp
592   USE agrif_top_sponge
593   !!
594   IMPLICIT NONE
595   !
596   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
597   LOGICAL :: check_namelist
598   !!----------------------------------------------------------------------
599
600
601   ! 1. Declaration of the type of variable which have to be interpolated
602   !---------------------------------------------------------------------
603   CALL agrif_declare_var_top
604
605   ! 2. First interpolations of potentially non zero fields
606   !-------------------------------------------------------
607   Agrif_SpecialValue=0.
608   Agrif_UseSpecialValue = .TRUE.
609   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
610   Agrif_UseSpecialValue = .FALSE.
611   CALL Agrif_Sponge
612   tabspongedone_trn = .FALSE.
613   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
614   ! reset tsa to zero
615   tra(:,:,:,:) = 0.
616
617
618   ! 3. Some controls
619   !-----------------
620   check_namelist = .TRUE.
621
622   IF( check_namelist ) THEN
623      ! Check time steps
624      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
625         WRITE(cl_check1,*)  Agrif_Parent(rdt)
626         WRITE(cl_check2,*)  rdt
627         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
628         CALL ctl_stop( 'incompatible time step between grids',   &
629               &               'parent grid value : '//cl_check1    ,   & 
630               &               'child  grid value : '//cl_check2    ,   & 
631               &               'value on child grid should be changed to  &
632               &               :'//cl_check3  )
633      ENDIF
634
635      ! Check run length
636      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
637            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
638         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
639         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
640         CALL ctl_warn( 'incompatible run length between grids'               ,   &
641               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
642               &              ' nitend on fine grid will be change to : '//cl_check2    )
643         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
644         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
645      ENDIF
646
647      ! Check coordinates
648      IF( ln_zps ) THEN
649         ! check parameters for partial steps
650         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
651            WRITE(*,*) 'incompatible e3zps_min between grids'
652            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
653            WRITE(*,*) 'child grid  :',e3zps_min
654            WRITE(*,*) 'those values should be identical'
655            STOP
656         ENDIF
657         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN
658            WRITE(*,*) 'incompatible e3zps_rat between grids'
659            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
660            WRITE(*,*) 'child grid  :',e3zps_rat
661            WRITE(*,*) 'those values should be identical'                 
662            STOP
663         ENDIF
664      ENDIF
665      ! Check passive tracer cell
666      IF( nn_dttrc .NE. 1 ) THEN
667         WRITE(*,*) 'nn_dttrc should be equal to 1'
668      ENDIF
669   ENDIF
670
671   CALL Agrif_Update_trc(0)
672   !
673   Agrif_UseSpecialValueInUpdate = .FALSE.
674   nbcline_trc = 0
675   !
676END SUBROUTINE Agrif_InitValues_cont_top
677
678
679SUBROUTINE agrif_declare_var_top
680   !!----------------------------------------------------------------------
681   !!                 *** ROUTINE agrif_declare_var_top ***
682   !!
683   !! ** Purpose :: Declaration of TOP variables to be interpolated
684   !!----------------------------------------------------------------------
685   USE agrif_util
686   USE agrif_oce
687   USE dom_oce
688   USE trc
689   !!
690   IMPLICIT NONE
691   !
692   INTEGER :: ind1, ind2, ind3
693   !!----------------------------------------------------------------------
694
695   ! 1. Declaration of the type of variable which have to be interpolated
696   !---------------------------------------------------------------------
697   ind1 =     nbghostcells
698   ind2 = 1 + nbghostcells
699   ind3 = 2 + nbghostcells
700   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)
701   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)
702
703   ! 2. Type of interpolation
704   !-------------------------
705   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
706   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
707
708   ! 3. Location of interpolation
709   !-----------------------------
710   CALL Agrif_Set_bc(trn_id,(/0,ind1/))
711   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
712
713   ! 5. Update type
714   !---------------
715   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
716
717!   Higher order update
718!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
719
720   !
721END SUBROUTINE agrif_declare_var_top
722# endif
723
724SUBROUTINE Agrif_detect( kg, ksizex )
725   !!----------------------------------------------------------------------
726   !!                      *** ROUTINE Agrif_detect ***
727   !!----------------------------------------------------------------------
728   INTEGER, DIMENSION(2) :: ksizex
729   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
730   !!----------------------------------------------------------------------
731   !
732   RETURN
733   !
734END SUBROUTINE Agrif_detect
735
736
737SUBROUTINE agrif_nemo_init
738   !!----------------------------------------------------------------------
739   !!                     *** ROUTINE agrif_init ***
740   !!----------------------------------------------------------------------
741   USE agrif_oce 
742   USE agrif_ice
743   USE in_out_manager
744   USE lib_mpp
745   !!
746   IMPLICIT NONE
747   !
748   INTEGER  ::   ios                 ! Local integer output status for namelist read
749   INTEGER  ::   iminspon
750   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
751   !!--------------------------------------------------------------------------------------
752   !
753   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
754   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
755901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
756
757   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
758   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
759902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
760   IF(lwm) WRITE ( numond, namagrif )
761   !
762   IF(lwp) THEN                    ! control print
763      WRITE(numout,*)
764      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
765      WRITE(numout,*) '~~~~~~~~~~~~~~~'
766      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
767      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
768      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
769      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
770      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
771      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
772      WRITE(numout,*) 
773   ENDIF
774   !
775   ! convert DOCTOR namelist name into OLD names
776   nbclineupdate = nn_cln_update
777   visc_tra      = rn_sponge_tra
778   visc_dyn      = rn_sponge_dyn
779   !
780   ! Check sponge length:
781   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
782   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
783   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
784   !
785   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
786   !
787END SUBROUTINE agrif_nemo_init
788
789# if defined key_mpp_mpi
790
791SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
792   !!----------------------------------------------------------------------
793   !!                     *** ROUTINE Agrif_detect ***
794   !!----------------------------------------------------------------------
795   USE dom_oce
796   !!
797   IMPLICIT NONE
798   !
799   INTEGER :: indglob, indloc, nprocloc, i
800   !!----------------------------------------------------------------------
801   !
802   SELECT CASE( i )
803   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
804   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
805   CASE DEFAULT
806      indglob = indloc
807   END SELECT
808   !
809END SUBROUTINE Agrif_InvLoc
810
811
812SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
813   !!----------------------------------------------------------------------
814   !!                 *** ROUTINE Agrif_get_proc_info ***
815   !!----------------------------------------------------------------------
816   USE par_oce
817   !!
818   IMPLICIT NONE
819   !
820   INTEGER, INTENT(out) :: imin, imax
821   INTEGER, INTENT(out) :: jmin, jmax
822   !!----------------------------------------------------------------------
823   !
824   imin = nimppt(Agrif_Procrank+1)  ! ?????
825   jmin = njmppt(Agrif_Procrank+1)  ! ?????
826   imax = imin + jpi - 1
827   jmax = jmin + jpj - 1
828   !
829END SUBROUTINE Agrif_get_proc_info
830
831
832SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
833   !!----------------------------------------------------------------------
834   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
835   !!----------------------------------------------------------------------
836   USE par_oce
837   !!
838   IMPLICIT NONE
839   !
840   INTEGER,  INTENT(in)  :: imin, imax
841   INTEGER,  INTENT(in)  :: jmin, jmax
842   INTEGER,  INTENT(in)  :: nbprocs
843   REAL(wp), INTENT(out) :: grid_cost
844   !!----------------------------------------------------------------------
845   !
846   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
847   !
848END SUBROUTINE Agrif_estimate_parallel_cost
849
850# endif
851
852#else
853SUBROUTINE Subcalledbyagrif
854   !!----------------------------------------------------------------------
855   !!                   *** ROUTINE Subcalledbyagrif ***
856   !!----------------------------------------------------------------------
857   WRITE(*,*) 'Impossible to be here'
858END SUBROUTINE Subcalledbyagrif
859#endif
Note: See TracBrowser for help on using the repository browser.