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

source: branches/2013/dev_r3853_CNRS9_ConfSetting/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 4044

Last change on this file since 4044 was 4044, checked in by clevy, 11 years ago

Configuration setting/add SETTE compatibility, see ticket:#1074

  • Property svn:keywords set to Id
File size: 23.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 obc_par
61   USE bdy_par
62
63   IMPLICIT NONE
64   !!----------------------------------------------------------------------
65   ! 0. Initializations
66   !-------------------
67   IF( cp_cfg == 'orca' ) then
68      IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 &
69  &                      .OR. jp_cfg == 4 ) THEN
70         jp_cfg = -1    ! set special value for jp_cfg on fine grids
71         cp_cfg = "default"
72      ENDIF
73   ENDIF
74   ! Specific fine grid Initializations
75   ! no tracer damping on fine grids
76   ln_tradmp = .FALSE.
77   ! no open boundary on fine grids
78   lk_obc = .FALSE.
79   lk_bdy = .FALSE.
80
81
82   CALL nemo_init  ! Initializations of each fine grid
83
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     
92END SUBROUTINE Agrif_initvalues
93
94
95SUBROUTINE Agrif_InitValues_cont_dom
96   !!----------------------------------------------------------------------
97   !!                 *** ROUTINE Agrif_InitValues_cont ***
98   !!
99   !! ** Purpose ::   Declaration of variables to be interpolated
100   !!----------------------------------------------------------------------
101   USE Agrif_Util
102   USE oce 
103   USE dom_oce
104   USE nemogcm
105   USE sol_oce
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
115   ! Declaration of the type of variable which have to be interpolated
116   !---------------------------------------------------------------------
117   CALL agrif_declare_var_dom
118   !
119END SUBROUTINE Agrif_InitValues_cont_dom
120
121
122SUBROUTINE agrif_declare_var_dom
123   !!----------------------------------------------------------------------
124   !!                 *** ROUTINE agrif_declarE_var ***
125   !!
126   !! ** Purpose :: Declaration of variables to be interpolated
127   !!----------------------------------------------------------------------
128   USE agrif_util
129   USE par_oce       !   ONLY : jpts
130   USE oce
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/),(/jpi,jpj/),e1u_id)
137   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
138
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
155END SUBROUTINE agrif_declare_var_dom
156
157
158# if ! defined key_offline
159
160SUBROUTINE Agrif_InitValues_cont
161   !!----------------------------------------------------------------------
162   !!                 *** ROUTINE Agrif_InitValues_cont ***
163   !!
164   !! ** Purpose ::   Declaration of variables to be interpolated
165   !!----------------------------------------------------------------------
166   USE Agrif_Util
167   USE oce 
168   USE dom_oce
169   USE nemogcm
170   USE sol_oce
171   USE in_out_manager
172   USE agrif_opa_update
173   USE agrif_opa_interp
174   USE agrif_opa_sponge
175   !
176   IMPLICIT NONE
177   !
178   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp
179   REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp
180   LOGICAL :: check_namelist
181   !!----------------------------------------------------------------------
182
183   ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) )
184   ALLOCATE( tabuvtemp(jpi, jpj, jpk)       )
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(tabtstemp,tsn_id,calledweight=1.,procname=interptsn)
196   Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn)
197
198   Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu)
199   Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv)
200   Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun)
201   Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn)
202   Agrif_UseSpecialValue = .FALSE.
203
204   ! 3. Some controls
205   !-----------------
206   check_namelist = .true.
207
208   IF( check_namelist ) THEN
209
210      ! Check time steps           
211      IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN
212         WRITE(*,*) 'incompatible time step between grids'
213         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
214         WRITE(*,*) 'child  grid value : ',nint(rdt)
215         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
216         STOP
217      ENDIF
218
219      ! Check run length
220      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
221           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
222         WRITE(*,*) 'incompatible run length between grids'
223         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
224              Agrif_Parent(nit000)+1),' time step'
225         WRITE(*,*) 'child  grid value : ', &
226              (nitend-nit000+1),' time step'
227         WRITE(*,*) 'value on child grid should be : ', &
228              Agrif_IRhot() * (Agrif_Parent(nitend)- &
229              Agrif_Parent(nit000)+1)
230         STOP
231      ENDIF
232
233      ! Check coordinates
234      IF( ln_zps ) THEN
235         ! check parameters for partial steps
236         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
237            WRITE(*,*) 'incompatible e3zps_min between grids'
238            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
239            WRITE(*,*) 'child grid  :',e3zps_min
240            WRITE(*,*) 'those values should be identical'
241            STOP
242         ENDIF
243         IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
244            WRITE(*,*) 'incompatible e3zps_rat between grids'
245            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
246            WRITE(*,*) 'child grid  :',e3zps_rat
247            WRITE(*,*) 'those values should be identical'                 
248            STOP
249         ENDIF
250      ENDIF
251   ENDIF
252
253   CALL Agrif_Update_tra(0)
254   CALL Agrif_Update_dyn(0)
255
256   nbcline = 0
257   !
258   DEALLOCATE(tabtstemp)
259   DEALLOCATE(tabuvtemp)
260   !
261END SUBROUTINE Agrif_InitValues_cont
262
263
264SUBROUTINE agrif_declare_var
265   !!----------------------------------------------------------------------
266   !!                 *** ROUTINE agrif_declarE_var ***
267   !!
268   !! ** Purpose :: Declaration of variables to be interpolated
269   !!----------------------------------------------------------------------
270   USE agrif_util
271   USE par_oce       !   ONLY : jpts
272   USE oce
273   IMPLICIT NONE
274   !!----------------------------------------------------------------------
275
276   ! 1. Declaration of the type of variable which have to be interpolated
277   !---------------------------------------------------------------------
278   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id)
279   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id)
280   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id)
281
282   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id)
283   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id)
284   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id)
285   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id)
286
287   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
288   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id)
289
290   ! 2. Type of interpolation
291   !-------------------------
292   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
293   CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear)
294
295   Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
296   Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
297
298   Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
299   Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
300
301   ! 3. Location of interpolation
302   !-----------------------------
303   Call Agrif_Set_bc(un_id,(/0,1/))
304   Call Agrif_Set_bc(vn_id,(/0,1/))
305
306   Call Agrif_Set_bc(tsn_id,(/0,1/))
307   Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/))
308
309   Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/))
310   Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/))
311
312   ! 5. Update type
313   !---------------
314   Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
315   Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average)
316
317   Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
318   Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average)
319
320   Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
321   Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
322
323END SUBROUTINE agrif_declare_var
324# endif
325
326#  if defined key_lim2
327SUBROUTINE Agrif_InitValues_cont_lim2
328   !!----------------------------------------------------------------------
329   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 ***
330   !!
331   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2
332   !!----------------------------------------------------------------------
333   USE Agrif_Util
334   USE ice_2
335   USE agrif_ice
336   USE in_out_manager
337   USE agrif_lim2_update
338   USE agrif_lim2_interp
339   USE lib_mpp
340   !
341   IMPLICIT NONE
342   !
343   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel
344   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv
345   !!----------------------------------------------------------------------
346
347   ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7))
348
349   ! 1. Declaration of the type of variable which have to be interpolated
350   !---------------------------------------------------------------------
351   CALL agrif_declare_var_lim2
352
353   ! 2. First interpolations of potentially non zero fields
354   !-------------------------------------------------------
355   Agrif_SpecialValue=-9999.
356   Agrif_UseSpecialValue = .TRUE.
357   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )
358   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   )
359   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   )
360   Agrif_SpecialValue=0.
361   Agrif_UseSpecialValue = .FALSE.
362
363   ! 3. Some controls
364   !-----------------
365
366#   if ! defined key_lim2_vp
367   lim_nbstep = 1.
368   CALL agrif_rhg_lim2_load
369   CALL agrif_trp_lim2_load
370   lim_nbstep = 0.
371#   endif
372   !RB mandatory but why ???
373   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN
374   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')
375   !         nbclineupdate = nn_fsbc
376   !       ENDIF
377   CALL Agrif_Update_lim2(0)
378   !
379   DEALLOCATE( zvel, zadv )
380   !
381END SUBROUTINE Agrif_InitValues_cont_lim2
382
383SUBROUTINE agrif_declare_var_lim2
384   !!----------------------------------------------------------------------
385   !!                 *** ROUTINE agrif_declare_var_lim2 ***
386   !!
387   !! ** Purpose :: Declaration of variables to be interpolated for LIM2
388   !!----------------------------------------------------------------------
389   USE agrif_util
390   USE ice_2
391
392   IMPLICIT NONE
393   !!----------------------------------------------------------------------
394
395   ! 1. Declaration of the type of variable which have to be interpolated
396   !---------------------------------------------------------------------
397   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )
398#   if defined key_lim2_vp
399   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
400   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
401#   else
402   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
403   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
404#   endif
405
406   ! 2. Type of interpolation
407   !-------------------------
408   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
409   Call Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
410   Call Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
411
412   ! 3. Location of interpolation
413   !-----------------------------
414   Call Agrif_Set_bc(adv_ice_id ,(/0,1/))
415   Call Agrif_Set_bc(u_ice_id,(/0,1/))
416   Call Agrif_Set_bc(v_ice_id,(/0,1/))
417
418   ! 5. Update type
419   !---------------
420   Call Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
421   Call Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
422   Call Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
423
424END SUBROUTINE agrif_declare_var_lim2
425#  endif
426
427
428# if defined key_top
429SUBROUTINE Agrif_InitValues_cont_top
430   !!----------------------------------------------------------------------
431   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
432   !!
433   !! ** Purpose :: Declaration of variables to be interpolated
434   !!----------------------------------------------------------------------
435   USE Agrif_Util
436   USE oce 
437   USE dom_oce
438   USE nemogcm
439   USE par_trc
440   USE trc
441   USE in_out_manager
442   USE agrif_top_update
443   USE agrif_top_interp
444   USE agrif_top_sponge
445   !
446   IMPLICIT NONE
447   !
448   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp
449   LOGICAL :: check_namelist
450   !!----------------------------------------------------------------------
451
452   ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )
453
454
455   ! 1. Declaration of the type of variable which have to be interpolated
456   !---------------------------------------------------------------------
457   CALL agrif_declare_var_top
458
459   ! 2. First interpolations of potentially non zero fields
460   !-------------------------------------------------------
461   Agrif_SpecialValue=0.
462   Agrif_UseSpecialValue = .TRUE.
463   Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn)
464   Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn)
465   Agrif_UseSpecialValue = .FALSE.
466
467   ! 3. Some controls
468   !-----------------
469   check_namelist = .true.
470
471   IF( check_namelist ) THEN
472#  if defined offline     
473      ! Check time steps
474      IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
475         WRITE(*,*) 'incompatible time step between grids'
476         WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
477         WRITE(*,*) 'child  grid value : ',nint(rdt)
478         WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
479         STOP
480      ENDIF
481
482      ! Check run length
483      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
484           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
485         WRITE(*,*) 'incompatible run length between grids'
486         WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
487              Agrif_Parent(nit000)+1),' time step'
488         WRITE(*,*) 'child  grid value : ', &
489              (nitend-nit000+1),' time step'
490         WRITE(*,*) 'value on child grid should be : ', &
491              Agrif_IRhot() * (Agrif_Parent(nitend)- &
492              Agrif_Parent(nit000)+1)
493         STOP
494      ENDIF
495
496      ! Check coordinates
497      IF( ln_zps ) THEN
498         ! check parameters for partial steps
499         IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
500            WRITE(*,*) 'incompatible e3zps_min between grids'
501            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
502            WRITE(*,*) 'child grid  :',e3zps_min
503            WRITE(*,*) 'those values should be identical'
504            STOP
505         ENDIF
506         IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
507            WRITE(*,*) 'incompatible e3zps_rat between grids'
508            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
509            WRITE(*,*) 'child grid  :',e3zps_rat
510            WRITE(*,*) 'those values should be identical'                 
511            STOP
512         ENDIF
513      ENDIF
514#  endif         
515      ! Check passive tracer cell
516      IF( nn_dttrc .ne. 1 ) THEN
517         WRITE(*,*) 'nn_dttrc should be equal to 1'
518      ENDIF
519   ENDIF
520
521!ch   CALL Agrif_Update_trc(0)
522   nbcline_trc = 0
523   !
524   DEALLOCATE(tabtrtemp)
525   !
526END SUBROUTINE Agrif_InitValues_cont_top
527
528
529SUBROUTINE agrif_declare_var_top
530   !!----------------------------------------------------------------------
531   !!                 *** ROUTINE agrif_declare_var_top ***
532   !!
533   !! ** Purpose :: Declaration of TOP variables to be interpolated
534   !!----------------------------------------------------------------------
535   USE agrif_util
536   USE dom_oce
537   USE trc
538
539   IMPLICIT NONE
540
541   ! 1. Declaration of the type of variable which have to be interpolated
542   !---------------------------------------------------------------------
543   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id)
544   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id)
545   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id)
546
547   ! 2. Type of interpolation
548   !-------------------------
549   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
550   CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear)
551
552   ! 3. Location of interpolation
553   !-----------------------------
554   Call Agrif_Set_bc(trn_id,(/0,1/))
555   Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/))
556
557   ! 5. Update type
558   !---------------
559   Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
560   Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average)
561
562
563END SUBROUTINE agrif_declare_var_top
564# endif
565
566SUBROUTINE Agrif_detect( kg, ksizex )
567   !!----------------------------------------------------------------------
568   !!   *** ROUTINE Agrif_detect ***
569   !!----------------------------------------------------------------------
570   USE Agrif_Types
571   !
572   INTEGER, DIMENSION(2) :: ksizex
573   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
574   !!----------------------------------------------------------------------
575   !
576   RETURN
577   !
578END SUBROUTINE Agrif_detect
579
580
581SUBROUTINE agrif_nemo_init
582   !!----------------------------------------------------------------------
583   !!                     *** ROUTINE agrif_init ***
584   !!----------------------------------------------------------------------
585   USE agrif_oce 
586   USE agrif_ice
587   USE in_out_manager
588   USE lib_mpp
589   IMPLICIT NONE
590   !
591   INTEGER  ::   ios                 ! Local integer output status for namelist read
592   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
593   !!----------------------------------------------------------------------
594   !
595      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
596      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
597901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
598
599      REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
600      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
601902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
602      WRITE ( numond, namagrif )
603   !
604   IF(lwp) THEN                    ! control print
605      WRITE(numout,*)
606      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
607      WRITE(numout,*) '~~~~~~~~~~~~~~~'
608      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
609      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
610      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
611      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
612      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
613      WRITE(numout,*) 
614   ENDIF
615   !
616   ! convert DOCTOR namelist name into OLD names
617   nbclineupdate = nn_cln_update
618   visc_tra      = rn_sponge_tra
619   visc_dyn      = rn_sponge_dyn
620   !
621   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed')
622# if defined key_lim2
623   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed')
624# endif
625   !
626END SUBROUTINE agrif_nemo_init
627
628# if defined key_mpp_mpi
629
630SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
631   !!----------------------------------------------------------------------
632   !!                     *** ROUTINE Agrif_detect ***
633   !!----------------------------------------------------------------------
634   USE dom_oce
635   IMPLICIT NONE
636   !
637   INTEGER :: indglob, indloc, nprocloc, i
638   !!----------------------------------------------------------------------
639   !
640   SELECT CASE( i )
641   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
642   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
643   CASE(3)   ;   indglob = indloc
644   CASE(4)   ;   indglob = indloc
645   END SELECT
646   !
647END SUBROUTINE Agrif_InvLoc
648
649# endif
650
651#else
652SUBROUTINE Subcalledbyagrif
653   !!----------------------------------------------------------------------
654   !!                   *** ROUTINE Subcalledbyagrif ***
655   !!----------------------------------------------------------------------
656   WRITE(*,*) 'Impossible to be here'
657END SUBROUTINE Subcalledbyagrif
658#endif
Note: See TracBrowser for help on using the repository browser.