New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
agrif_user.F90 in branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 7692

Last change on this file since 7692 was 7692, checked in by frrh, 7 years ago

Strip out svn keywords

File size: 24.9 KB
RevLine 
[393]1#if defined key_agrif
[3680]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
[1156]14   !!----------------------------------------------------------------------
[3680]15   !!                 *** ROUTINE Agrif_InitWorkspace ***
[1156]16   !!----------------------------------------------------------------------
[3680]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
[4147]33      jpk     = jpkdta 
34      jpim1   = jpi-1 
35      jpjm1   = jpj-1 
36      jpkm1   = jpk-1                                         
37      jpij    = jpi*jpj 
[3680]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
[1156]47
[390]48
[3680]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
[1300]61
[3680]62   IMPLICIT NONE
63   !!----------------------------------------------------------------------
64   ! 0. Initializations
65   !-------------------
[4147]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
[3680]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.
[2031]78
[4147]79
[3680]80   CALL nemo_init  ! Initializations of each fine grid
[4147]81
[3680]82   CALL agrif_nemo_init
83   CALL Agrif_InitValues_cont_dom
[2715]84# if ! defined key_offline
[3680]85   CALL Agrif_InitValues_cont
[2715]86# endif       
87# if defined key_top
[3680]88   CALL Agrif_InitValues_cont_top
[2715]89# endif     
[3680]90END SUBROUTINE Agrif_initvalues
[2031]91
[3680]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
[2715]156# if ! defined key_offline
[390]157
[3680]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
[4326]178   REAL(wp), DIMENSION(:,:    ), ALLOCATABLE :: tab2d
[3680]179   LOGICAL :: check_namelist
180   !!----------------------------------------------------------------------
[390]181
[3680]182   ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) )
183   ALLOCATE( tabuvtemp(jpi, jpj, jpk)       )
[4326]184   ALLOCATE( tab2d(jpi, jpj)                )
[3294]185
186
[3680]187   ! 1. Declaration of the type of variable which have to be interpolated
188   !---------------------------------------------------------------------
189   CALL agrif_declare_var
[636]190
[3680]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)
[390]197
[3680]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)
[4326]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)
[3680]206   Agrif_UseSpecialValue = .FALSE.
[628]207
[3680]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'
[636]245            STOP
246         ENDIF
[3680]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'                 
[636]252            STOP
253         ENDIF
[390]254      ENDIF
[3680]255   ENDIF
[636]256
[3680]257   CALL Agrif_Update_tra(0)
258   CALL Agrif_Update_dyn(0)
[1300]259
[3680]260   nbcline = 0
261   !
262   DEALLOCATE(tabtstemp)
263   DEALLOCATE(tabuvtemp)
[4326]264   DEALLOCATE(tab2d)
[3680]265   !
266END SUBROUTINE Agrif_InitValues_cont
[1605]267
[3294]268
[3680]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   !!----------------------------------------------------------------------
[2715]280
[3680]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)
[2715]286
[3680]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)
[2715]291
[4326]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)
[3680]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)
[4486]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)
[2715]298
[3680]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)
[2715]303
[3680]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)
[2715]306
[3680]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)
[2715]309
[4326]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)
[4486]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)
[4326]315
[3680]316   ! 3. Location of interpolation
317   !-----------------------------
318   Call Agrif_Set_bc(un_id,(/0,1/))
319   Call Agrif_Set_bc(vn_id,(/0,1/))
[2715]320
[4326]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/))
[4486]324   Call Agrif_Set_bc(ub2b_id,(/0,1/))
325   Call Agrif_Set_bc(vb2b_id,(/0,1/))
[4326]326
[3680]327   Call Agrif_Set_bc(tsn_id,(/0,1/))
328   Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/))
[2715]329
[3680]330   Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/))
331   Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/))
[2715]332
[3680]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)
[2715]337
[3680]338   Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
339   Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average)
[2715]340
[3680]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
[4486]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
[3680]347END SUBROUTINE agrif_declare_var
[2715]348# endif
[3680]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
[2715]452# if defined key_top
[3680]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   !!----------------------------------------------------------------------
[1300]475
[3680]476   ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )
[1300]477
478
[3680]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
[2715]496#  if defined offline     
[3680]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'
[1300]528            STOP
529         ENDIF
[3680]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'                 
[1300]535            STOP
536         ENDIF
[3680]537      ENDIF
[2715]538#  endif         
[3680]539      ! Check passive tracer cell
540      IF( nn_dttrc .ne. 1 ) THEN
541         WRITE(*,*) 'nn_dttrc should be equal to 1'
[1300]542      ENDIF
[3680]543   ENDIF
[1300]544
[3680]545!ch   CALL Agrif_Update_trc(0)
546   nbcline_trc = 0
547   !
548   DEALLOCATE(tabtrtemp)
549   !
550END SUBROUTINE Agrif_InitValues_cont_top
[2715]551
552
[3680]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
[2715]562
[3680]563   IMPLICIT NONE
[2715]564
[3680]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)
[2715]570
[3680]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
[2715]588# endif
[636]589
[3680]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
[390]603
[782]604
[3680]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   !
[4147]615   INTEGER  ::   ios                 ! Local integer output status for namelist read
[3680]616   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
617   !!----------------------------------------------------------------------
618   !
[4147]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 )
[4624]626      IF(lwm) WRITE ( numond, namagrif )
[3680]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
[1605]652# if defined key_mpp_mpi
653
[3680]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
[390]672
[1605]673# endif
674
[390]675#else
[3680]676SUBROUTINE Subcalledbyagrif
677   !!----------------------------------------------------------------------
678   !!                   *** ROUTINE Subcalledbyagrif ***
679   !!----------------------------------------------------------------------
680   WRITE(*,*) 'Impossible to be here'
681END SUBROUTINE Subcalledbyagrif
[390]682#endif
Note: See TracBrowser for help on using the repository browser.