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

source: branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 8125

Last change on this file since 8125 was 7158, checked in by clem, 8 years ago

debug branch
  • Property svn:keywords set to Id
File size: 36.5 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.
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#if defined key_dynspg_ts
213   Agrif_UseSpecialValue = .TRUE.
214   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
215
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      IF( ln_zps ) THEN
263         ! check parameters for partial steps
264         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
265            WRITE(*,*) 'incompatible e3zps_min between grids'
266            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
267            WRITE(*,*) 'child grid  :',e3zps_min
268            WRITE(*,*) 'those values should be identical'
269            STOP
270         ENDIF
271         IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
272            WRITE(*,*) 'incompatible e3zps_rat between grids'
273            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
274            WRITE(*,*) 'child grid  :',e3zps_rat
275            WRITE(*,*) 'those values should be identical'                 
276            STOP
277         ENDIF
278      ENDIF
279      ! check if masks and bathymetries match
280      IF(ln_chk_bathy) THEN
281         !
282         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
283         !
284         kindic_agr = 0
285         ! check if umask agree with parent along western and eastern boundaries:
286         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
287         ! check if vmask agree with parent along northern and southern boundaries:
288         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
289    ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
290         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
291         !
292         IF (lk_mpp) CALL mpp_sum( kindic_agr )
293         IF( kindic_agr /= 0 ) THEN                   
294            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
295         ELSE
296            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
297         END IF
298      ENDIF
299      !
300   ENDIF
301   !
302   ! Do update at initialisation because not done before writing restarts
303   ! This would indeed change boundary conditions values at initial time
304   ! hence produce restartability issues.
305   ! Note that update below is recursive (with lk_agrif_doupd=T):
306   !
307!!#if ! defined key_sas2D
308! JC: I am not sure if Agrif_MaxLevel() is the "relative"
309!     or the absolute maximum nesting level...TBC                       
310   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 
311      ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics
312      CALL Agrif_Update_tra()
313      CALL Agrif_Update_dyn()
314   ENDIF
315!!#endif   
316   !
317# if defined key_zdftke
318!   CALL Agrif_Update_tke(0)
319# endif
320   !
321   Agrif_UseSpecialValueInUpdate = .FALSE.
322   nbcline = 0
323   lk_agrif_doupd = .FALSE.
324
325   !
326END SUBROUTINE Agrif_InitValues_cont
327
328
329SUBROUTINE agrif_declare_var
330   !!----------------------------------------------------------------------
331   !!                 *** ROUTINE agrif_declarE_var ***
332   !!
333   !! ** Purpose :: Declaration of variables to be interpolated
334   !!----------------------------------------------------------------------
335   USE agrif_util
336   USE par_oce       !   ONLY : jpts
337   USE oce
338   USE agrif_oce
339   IMPLICIT NONE
340   !!----------------------------------------------------------------------
341
342   ! 1. Declaration of the type of variable which have to be interpolated
343   !---------------------------------------------------------------------
344   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)
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_sponge_id)
346
347   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
348   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
349   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
350   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
351   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
352   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
353
354   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
355   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
356   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
357
358   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)
359
360   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
361   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
362   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
363   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
364   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
365   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
366
367   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
368
369# if defined key_zdftke
370   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
371   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
372   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
373# endif
374
375   ! 2. Type of interpolation
376   !-------------------------
377   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
378
379   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
380   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
381
382   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
383
384   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
385   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
386   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
387   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
388   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
389
390
391   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
392   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
393
394   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
395   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
396   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
397
398# if defined key_zdftke
399   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear)
400# endif
401
402
403   ! 3. Location of interpolation
404   !-----------------------------
405   CALL Agrif_Set_bc(tsn_id,(/0,1/))
406   CALL Agrif_Set_bc(un_interp_id,(/0,1/))
407   CALL Agrif_Set_bc(vn_interp_id,(/0,1/))
408
409!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))
410!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))
411!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))
412   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
413   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
414   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
415
416   CALL Agrif_Set_bc(sshn_id,(/0,0/))
417   CALL Agrif_Set_bc(unb_id ,(/0,0/))
418   CALL Agrif_Set_bc(vnb_id ,(/0,0/))
419   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
420   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
421
422   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9
423   CALL Agrif_Set_bc(umsk_id,(/0,0/))
424   CALL Agrif_Set_bc(vmsk_id,(/0,0/))
425
426# if defined key_zdftke
427   CALL Agrif_Set_bc(avm_id ,(/0,1/))
428# endif
429
430   ! 5. Update type
431   !---------------
432   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
433
434   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
435
436   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
437   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
438
439   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
440
441   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
442   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
443
444# if defined key_zdftke
445   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
446   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
447   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
448# endif
449
450! High order updates
451!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
452!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
453!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
454!
455!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
456!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
457!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
458
459   !
460END SUBROUTINE agrif_declare_var
461# endif
462
463#  if defined key_lim2
464SUBROUTINE Agrif_InitValues_cont_lim2
465   !!----------------------------------------------------------------------
466   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 ***
467   !!
468   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2
469   !!----------------------------------------------------------------------
470   USE Agrif_Util
471   USE ice_2
472   USE agrif_ice
473   USE in_out_manager
474   USE agrif_lim2_update
475   USE agrif_lim2_interp
476   USE lib_mpp
477   !
478   IMPLICIT NONE
479   !
480   !!----------------------------------------------------------------------
481
482   ! 1. Declaration of the type of variable which have to be interpolated
483   !---------------------------------------------------------------------
484   CALL agrif_declare_var_lim2
485
486   ! 2. First interpolations of potentially non zero fields
487   !-------------------------------------------------------
488   Agrif_SpecialValue=-9999.
489   Agrif_UseSpecialValue = .TRUE.
490   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )
491   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   )
492   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   )
493   Agrif_SpecialValue=0.
494   Agrif_UseSpecialValue = .FALSE.
495
496   ! 3. Some controls
497   !-----------------
498
499#   if ! defined key_lim2_vp
500   lim_nbstep = 1.
501   CALL agrif_rhg_lim2_load
502   CALL agrif_trp_lim2_load
503   lim_nbstep = 0.
504#   endif
505   !RB mandatory but why ???
506   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN
507   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')
508   !         nbclineupdate = nn_fsbc
509   !       ENDIF
510   CALL Agrif_Update_lim2(0)
511   !
512END SUBROUTINE Agrif_InitValues_cont_lim2
513
514SUBROUTINE agrif_declare_var_lim2
515   !!----------------------------------------------------------------------
516   !!                 *** ROUTINE agrif_declare_var_lim2 ***
517   !!
518   !! ** Purpose :: Declaration of variables to be interpolated for LIM2
519   !!----------------------------------------------------------------------
520   USE agrif_util
521   USE ice_2
522
523   IMPLICIT NONE
524   !!----------------------------------------------------------------------
525
526   ! 1. Declaration of the type of variable which have to be interpolated
527   !---------------------------------------------------------------------
528   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )
529#   if defined key_lim2_vp
530   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
531   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
532#   else
533   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
534   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
535#   endif
536
537   ! 2. Type of interpolation
538   !-------------------------
539   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
540   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
541   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
542
543   ! 3. Location of interpolation
544   !-----------------------------
545   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))
546   CALL Agrif_Set_bc(u_ice_id,(/0,1/))
547   CALL Agrif_Set_bc(v_ice_id,(/0,1/))
548
549   ! 5. Update type
550   !---------------
551   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
552   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
553   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
554   !
555END SUBROUTINE agrif_declare_var_lim2
556#  endif
557
558#if defined key_lim3
559SUBROUTINE Agrif_InitValues_cont_lim3
560   !!----------------------------------------------------------------------
561   !!                 *** ROUTINE Agrif_InitValues_cont_lim3 ***
562   !!
563   !! ** Purpose :: Initialisation of variables to be interpolated for LIM3
564   !!----------------------------------------------------------------------
565   USE Agrif_Util
566   USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
567   USE ice
568   USE agrif_ice
569   USE in_out_manager
570   USE agrif_lim3_update
571   USE agrif_lim3_interp
572   USE lib_mpp
573   !
574   IMPLICIT NONE
575   !!----------------------------------------------------------------------
576   !
577   ! Declaration of the type of variable which have to be interpolated (parent=>child)
578   !----------------------------------------------------------------------------------
579   CALL agrif_declare_var_lim3
580
581   ! Controls (clem)
582   ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
583   IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
584      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
585   ENDIF
586
587   ! stop if update frequency is different from nn_fsbc
588   IF( nbclineupdate > nn_fsbc )  CALL ctl_stop('With ice model on child grid, nn_cln_update should be set to 1 or nn_fsbc')
589
590
591   ! First Interpolations (using "after" ice subtime step => lim_nbstep=1)
592   !----------------------------------------------------------------------
593   lim_nbstep = 1
594   CALL agrif_interp_lim3('U') ! interpolation of ice velocities
595   CALL agrif_interp_lim3('V') ! interpolation of ice velocities
596   CALL agrif_interp_lim3('T') ! interpolation of ice tracers
597   lim_nbstep = 0
598   
599   ! Update in case 2 ways
600   !----------------------
601   CALL agrif_update_lim3(0)
602
603   !
604END SUBROUTINE Agrif_InitValues_cont_lim3
605
606SUBROUTINE agrif_declare_var_lim3
607   !!----------------------------------------------------------------------
608   !!                 *** ROUTINE agrif_declare_var_lim3 ***
609   !!
610   !! ** Purpose :: Declaration of variables to be interpolated for LIM3
611   !!----------------------------------------------------------------------
612   USE Agrif_Util
613   USE ice
614
615   IMPLICIT NONE
616   !!----------------------------------------------------------------------
617   !
618   ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
619   !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
620   !-------------------------------------------------------------------------------------
621   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id )
622   CALL agrif_declare_variable((/1,2/)    ,(/2,3/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
623   CALL agrif_declare_variable((/2,1/)    ,(/3,2/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
624
625   ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
626   !-----------------------------------
627   CALL Agrif_Set_bcinterp(tra_ice_id,  interp = AGRIF_linear)
628   CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
629   CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
630
631   ! 3. Set location of interpolations
632   !----------------------------------
633   CALL Agrif_Set_bc(tra_ice_id,(/0,1/))
634   CALL Agrif_Set_bc(u_ice_id  ,(/0,1/))
635   CALL Agrif_Set_bc(v_ice_id  ,(/0,1/))
636
637   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
638   !--------------------------------------------------
639   CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) ! clem je comprends pas average/copy
640   CALL Agrif_Set_Updatetype(u_ice_id  ,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
641   CALL Agrif_Set_Updatetype(v_ice_id  ,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
642
643END SUBROUTINE agrif_declare_var_lim3
644#endif
645
646
647# if defined key_top
648SUBROUTINE Agrif_InitValues_cont_top
649   !!----------------------------------------------------------------------
650   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
651   !!
652   !! ** Purpose :: Declaration of variables to be interpolated
653   !!----------------------------------------------------------------------
654   USE Agrif_Util
655   USE oce 
656   USE dom_oce
657   USE nemogcm
658   USE par_trc
659   USE lib_mpp
660   USE trc
661   USE in_out_manager
662   USE agrif_opa_sponge
663   USE agrif_top_update
664   USE agrif_top_interp
665   USE agrif_top_sponge
666   !
667   IMPLICIT NONE
668   !
669   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
670   LOGICAL :: check_namelist
671   !!----------------------------------------------------------------------
672
673
674   ! 1. Declaration of the type of variable which have to be interpolated
675   !---------------------------------------------------------------------
676   CALL agrif_declare_var_top
677
678   ! 2. First interpolations of potentially non zero fields
679   !-------------------------------------------------------
680   Agrif_SpecialValue=0.
681   Agrif_UseSpecialValue = .TRUE.
682   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
683   Agrif_UseSpecialValue = .FALSE.
684   CALL Agrif_Sponge
685   tabspongedone_trn = .FALSE.
686   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
687   ! reset tsa to zero
688   tra(:,:,:,:) = 0.
689
690
691   ! 3. Some controls
692   !-----------------
693   check_namelist = .TRUE.
694
695   IF( check_namelist ) THEN
696# if defined key_offline
697      ! Check time steps
698      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
699         WRITE(cl_check1,*)  Agrif_Parent(rdt)
700         WRITE(cl_check2,*)  rdt
701         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
702         CALL ctl_stop( 'incompatible time step between grids',   &
703               &               'parent grid value : '//cl_check1    ,   & 
704               &               'child  grid value : '//cl_check2    ,   & 
705               &               'value on child grid should be changed to  &
706               &               :'//cl_check3  )
707      ENDIF
708
709      ! Check run length
710      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
711            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
712         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
713         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
714         CALL ctl_warn( 'incompatible run length between grids'               ,   &
715               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
716               &              ' nitend on fine grid will be change to : '//cl_check2    )
717         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
718         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
719      ENDIF
720
721      ! Check coordinates
722      IF( ln_zps ) THEN
723         ! check parameters for partial steps
724         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
725            WRITE(*,*) 'incompatible e3zps_min between grids'
726            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
727            WRITE(*,*) 'child grid  :',e3zps_min
728            WRITE(*,*) 'those values should be identical'
729            STOP
730         ENDIF
731         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN
732            WRITE(*,*) 'incompatible e3zps_rat between grids'
733            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
734            WRITE(*,*) 'child grid  :',e3zps_rat
735            WRITE(*,*) 'those values should be identical'                 
736            STOP
737         ENDIF
738      ENDIF
739#  endif         
740      ! Check passive tracer cell
741      IF( nn_dttrc .NE. 1 ) THEN
742         WRITE(*,*) 'nn_dttrc should be equal to 1'
743      ENDIF
744   ENDIF
745
746   CALL Agrif_Update_trc(0)
747   !
748   Agrif_UseSpecialValueInUpdate = .FALSE.
749   nbcline_trc = 0
750   !
751END SUBROUTINE Agrif_InitValues_cont_top
752
753
754SUBROUTINE agrif_declare_var_top
755   !!----------------------------------------------------------------------
756   !!                 *** ROUTINE agrif_declare_var_top ***
757   !!
758   !! ** Purpose :: Declaration of TOP variables to be interpolated
759   !!----------------------------------------------------------------------
760   USE agrif_util
761   USE agrif_oce
762   USE dom_oce
763   USE trc
764
765   IMPLICIT NONE
766
767   ! 1. Declaration of the type of variable which have to be interpolated
768   !---------------------------------------------------------------------
769   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)
770   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)
771
772   ! 2. Type of interpolation
773   !-------------------------
774   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
775   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
776
777   ! 3. Location of interpolation
778   !-----------------------------
779   CALL Agrif_Set_bc(trn_id,(/0,1/))
780!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))
781   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
782
783   ! 5. Update type
784   !---------------
785   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
786
787!   Higher order update
788!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
789
790   !
791END SUBROUTINE agrif_declare_var_top
792# endif
793
794SUBROUTINE Agrif_detect( kg, ksizex )
795   !!----------------------------------------------------------------------
796   !!   *** ROUTINE Agrif_detect ***
797   !!----------------------------------------------------------------------
798   !
799   INTEGER, DIMENSION(2) :: ksizex
800   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
801   !!----------------------------------------------------------------------
802   !
803   RETURN
804   !
805END SUBROUTINE Agrif_detect
806
807
808SUBROUTINE agrif_nemo_init
809   !!----------------------------------------------------------------------
810   !!                     *** ROUTINE agrif_init ***
811   !!   Read by Child model only
812   !!----------------------------------------------------------------------
813   USE agrif_oce 
814   USE agrif_ice
815   USE in_out_manager
816   USE lib_mpp
817   IMPLICIT NONE
818   !
819   INTEGER  ::   ios                 ! Local integer output status for namelist read
820   INTEGER  ::   iminspon
821   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
822   !!--------------------------------------------------------------------------------------
823   !
824   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
825   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
826901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
827
828   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
829   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
830902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
831   IF(lwm) WRITE ( numond, namagrif )
832   !
833   IF(lwp) THEN                    ! control print
834      WRITE(numout,*)
835      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
836      WRITE(numout,*) '~~~~~~~~~~~~~~~'
837      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
838      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
839      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
840      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
841      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
842      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
843      WRITE(numout,*) 
844   ENDIF
845   !
846   ! convert DOCTOR namelist name into OLD names
847   nbclineupdate = nn_cln_update
848   visc_tra      = rn_sponge_tra
849   visc_dyn      = rn_sponge_dyn
850   !
851   ! Check sponge length:
852   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
853   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
854   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
855   !
856   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
857# if defined key_lim2
858   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') ! only for LIM2 (not LIM3)
859# endif
860   !
861END SUBROUTINE agrif_nemo_init
862
863# if defined key_mpp_mpi
864
865SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
866   !!----------------------------------------------------------------------
867   !!                     *** ROUTINE Agrif_detect ***
868   !!----------------------------------------------------------------------
869   USE dom_oce
870   IMPLICIT NONE
871   !
872   INTEGER :: indglob, indloc, nprocloc, i
873   !!----------------------------------------------------------------------
874   !
875   SELECT CASE( i )
876   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
877   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
878   CASE DEFAULT
879      indglob = indloc
880   END SELECT
881   !
882END SUBROUTINE Agrif_InvLoc
883
884SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
885   !!----------------------------------------------------------------------
886   !!                 *** ROUTINE Agrif_get_proc_info ***
887   !!----------------------------------------------------------------------
888   USE par_oce
889   IMPLICIT NONE
890   !
891   INTEGER, INTENT(out) :: imin, imax
892   INTEGER, INTENT(out) :: jmin, jmax
893   !!----------------------------------------------------------------------
894   !
895   imin = nimppt(Agrif_Procrank+1)  ! ?????
896   jmin = njmppt(Agrif_Procrank+1)  ! ?????
897   imax = imin + jpi - 1
898   jmax = jmin + jpj - 1
899   !
900END SUBROUTINE Agrif_get_proc_info
901
902SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
903   !!----------------------------------------------------------------------
904   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
905   !!----------------------------------------------------------------------
906   USE par_oce
907   IMPLICIT NONE
908   !
909   INTEGER,  INTENT(in)  :: imin, imax
910   INTEGER,  INTENT(in)  :: jmin, jmax
911   INTEGER,  INTENT(in)  :: nbprocs
912   REAL(wp), INTENT(out) :: grid_cost
913   !!----------------------------------------------------------------------
914   !
915   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
916   !
917END SUBROUTINE Agrif_estimate_parallel_cost
918
919# endif
920
921#else
922SUBROUTINE Subcalledbyagrif
923   !!----------------------------------------------------------------------
924   !!                   *** ROUTINE Subcalledbyagrif ***
925   !!----------------------------------------------------------------------
926   WRITE(*,*) 'Impossible to be here'
927END SUBROUTINE Subcalledbyagrif
928#endif
Note: See TracBrowser for help on using the repository browser.