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_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 7988

Last change on this file since 7988 was 7988, checked in by jchanut, 7 years ago

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