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

source: branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 7225

Last change on this file since 7225 was 7225, checked in by flavoni, 7 years ago

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