source: trunk/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 4673

Last change on this file since 4673 was 4624, checked in by acc, 7 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.

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