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

source: branches/UKMO/r6232_tracer_advection/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

Last change on this file was 9295, checked in by jcastill, 6 years ago

Remove svn keywords

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