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

source: branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 4789

Last change on this file since 4789 was 4789, checked in by rblod, 10 years ago

dev_r4765_CNRS_agrif: First update of AGRIF for dynamic only (_flt and _ts), see ticket #1380 and associated wiki page

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