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

source: branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 3289

Last change on this file since 3289 was 3289, checked in by rblod, 12 years ago

Fix agrif for 3_4_beta see ticket #921

  • Property svn:keywords set to Id
File size: 19.3 KB
Line 
1#if defined key_agrif
2   !!----------------------------------------------------------------------
3   !! NEMO/NST 3.3 , NEMO Consortium (2010)
4   !! $Id$
5   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
6   !!----------------------------------------------------------------------
7   SUBROUTINE agrif_before_regridding
8   END SUBROUTINE
9
10   SUBROUTINE Agrif_InitWorkspace
11      !!----------------------------------------------------------------------
12      !!                 *** ROUTINE Agrif_InitWorkspace ***
13      !!----------------------------------------------------------------------
14      USE par_oce
15      USE dom_oce
16      USE Agrif_Util
17      USE nemogcm
18      !
19      IMPLICIT NONE
20      !!----------------------------------------------------------------------
21      !
22      IF( .NOT. Agrif_Root() ) THEN
23         jpni = Agrif_Parent(jpni)
24         jpnj = Agrif_Parent(jpnj)
25         jpnij = Agrif_Parent(jpnij)
26         jpiglo  = nbcellsx + 2 + 2*nbghostcells
27         jpjglo  = nbcellsy + 2 + 2*nbghostcells
28         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
29         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
30         jpk     = jpkdta
31         jpim1   = jpi-1
32         jpjm1   = jpj-1
33         jpkm1   = jpk-1                                       
34         jpij    = jpi*jpj
35         jpidta  = jpiglo
36         jpjdta  = jpjglo
37         jpizoom = 1
38         jpjzoom = 1
39         nperio  = 0
40         jperio  = 0
41      ENDIF
42      !
43   END SUBROUTINE Agrif_InitWorkspace
44
45
46   SUBROUTINE Agrif_InitValues
47      !!----------------------------------------------------------------------
48      !!                 *** ROUTINE Agrif_InitValues ***
49      !!
50      !! ** Purpose :: Declaration of variables to be interpolated
51      !!----------------------------------------------------------------------
52      USE Agrif_Util
53      USE oce 
54      USE dom_oce
55      USE nemogcm
56      USE tradmp
57      USE obc_par
58      USE bdy_par
59
60      IMPLICIT NONE
61      !!----------------------------------------------------------------------
62
63      ! 0. Initializations
64      !-------------------
65#if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4
66      jp_cfg = -1    ! set special value for jp_cfg on fine grids
67      cp_cfg = "default"
68#endif
69
70      ! Specific fine grid Initializations
71      ! no tracer damping on fine grids
72      ln_tradmp = .FALSE.
73      ! no open boundary on fine grids
74      lk_obc = .FALSE.
75      lk_bdy = .FALSE.
76
77      CALL nemo_init  ! Initializations of each fine grid
78      CALL agrif_nemo_init
79# if ! defined key_offline
80      CALL Agrif_InitValues_cont
81# endif       
82# if defined key_top
83      CALL Agrif_InitValues_cont_top
84# endif     
85   END SUBROUTINE Agrif_initvalues
86
87# if ! defined key_offline
88
89   SUBROUTINE Agrif_InitValues_cont
90      !!----------------------------------------------------------------------
91      !!                 *** ROUTINE Agrif_InitValues_cont ***
92      !!
93      !! ** Purpose ::   Declaration of variables to be interpolated
94      !!----------------------------------------------------------------------
95      USE Agrif_Util
96      USE oce 
97      USE dom_oce
98      USE nemogcm
99      USE sol_oce
100      USE in_out_manager
101      USE agrif_opa_update
102      USE agrif_opa_interp
103      USE agrif_opa_sponge
104      !
105      IMPLICIT NONE
106      !
107      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp
108      REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp
109      LOGICAL :: check_namelist
110      !!----------------------------------------------------------------------
111
112      ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) )
113      ALLOCATE( tabuvtemp(jpi, jpj, jpk)       )
114
115
116      ! 1. Declaration of the type of variable which have to be interpolated
117      !---------------------------------------------------------------------
118      CALL agrif_declare_var
119
120      ! 2. First interpolations of potentially non zero fields
121      !-------------------------------------------------------
122      Agrif_SpecialValue=0.
123      Agrif_UseSpecialValue = .TRUE.
124      Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn)
125      Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn)
126
127      Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu)
128      Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv)
129      Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun)
130      Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn)
131      Agrif_UseSpecialValue = .FALSE.
132
133      ! 3. Some controls
134      !-----------------
135      check_namelist = .true.
136           
137      IF( check_namelist ) THEN
138     
139         ! Check time steps           
140         IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN
141            WRITE(*,*) 'incompatible time step between grids'
142            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
143            WRITE(*,*) 'child  grid value : ',nint(rdt)
144            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
145            STOP
146         ENDIF
147         
148         ! Check run length
149         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
150            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
151            WRITE(*,*) 'incompatible run length between grids'
152            WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
153               Agrif_Parent(nit000)+1),' time step'
154            WRITE(*,*) 'child  grid value : ', &
155               (nitend-nit000+1),' time step'
156            WRITE(*,*) 'value on child grid should be : ', &
157               Agrif_IRhot() * (Agrif_Parent(nitend)- &
158               Agrif_Parent(nit000)+1)
159            STOP
160         ENDIF
161         
162         ! Check coordinates
163         IF( ln_zps ) THEN
164            ! check parameters for partial steps
165            IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
166               WRITE(*,*) 'incompatible e3zps_min between grids'
167               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
168               WRITE(*,*) 'child grid  :',e3zps_min
169               WRITE(*,*) 'those values should be identical'
170               STOP
171            ENDIF         
172            IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
173               WRITE(*,*) 'incompatible e3zps_rat between grids'
174               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
175               WRITE(*,*) 'child grid  :',e3zps_rat
176               WRITE(*,*) 'those values should be identical'                 
177               STOP
178            ENDIF
179         ENDIF
180      ENDIF
181       
182      CALL Agrif_Update_tra(0)
183      CALL Agrif_Update_dyn(0)
184
185      nbcline = 0
186      !
187      DEALLOCATE(tabtstemp)
188      DEALLOCATE(tabuvtemp)
189      !
190   END SUBROUTINE Agrif_InitValues_cont
191
192
193   SUBROUTINE agrif_declare_var
194      !!----------------------------------------------------------------------
195      !!                 *** ROUTINE agrif_declarE_var ***
196      !!
197      !! ** Purpose :: Declaration of variables to be interpolated
198      !!----------------------------------------------------------------------
199      USE agrif_util
200      USE par_oce       !   ONLY : jpts
201      USE oce
202      IMPLICIT NONE
203      !!----------------------------------------------------------------------
204   
205      ! 1. Declaration of the type of variable which have to be interpolated
206      !---------------------------------------------------------------------
207      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)
208      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)
209      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)
210
211      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id)
212      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id)
213      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id)
214      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id)
215   
216      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
217      CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
218
219      CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
220      CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id)
221       
222      ! 2. Type of interpolation
223      !-------------------------
224      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
225      CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear)
226   
227      Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
228      Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
229
230      Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
231      Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
232
233      Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
234      Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
235
236      ! 3. Location of interpolation
237      !-----------------------------
238      Call Agrif_Set_bc(un_id,(/0,1/))
239      Call Agrif_Set_bc(vn_id,(/0,1/))
240
241      Call Agrif_Set_bc(e1u_id,(/0,0/))
242      Call Agrif_Set_bc(e2v_id,(/0,0/))
243
244      Call Agrif_Set_bc(tsn_id,(/0,1/))
245      Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/))
246
247      Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/))
248      Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/))
249
250      ! 5. Update type
251      !---------------
252      Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
253      Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average)
254
255      Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
256      Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average)
257
258      Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
259      Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
260
261      Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
262      Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
263
264   END SUBROUTINE agrif_declare_var
265# endif
266   
267# if defined key_top
268   SUBROUTINE Agrif_InitValues_cont_top
269      !!----------------------------------------------------------------------
270      !!                 *** ROUTINE Agrif_InitValues_cont_top ***
271      !!
272      !! ** Purpose :: Declaration of variables to be interpolated
273      !!----------------------------------------------------------------------
274      USE Agrif_Util
275      USE oce 
276      USE dom_oce
277      USE nemogcm
278      USE trc
279      USE in_out_manager
280      USE agrif_top_update
281      USE agrif_top_interp
282      USE agrif_top_sponge
283      !
284      IMPLICIT NONE
285      !
286      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp
287      LOGICAL :: check_namelist
288      !!----------------------------------------------------------------------
289
290      ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )
291     
292     
293      ! 1. Declaration of the type of variable which have to be interpolated
294      !---------------------------------------------------------------------
295      CALL agrif_declare_var_top
296
297      ! 2. First interpolations of potentially non zero fields
298      !-------------------------------------------------------
299      Agrif_SpecialValue=0.
300      Agrif_UseSpecialValue = .TRUE.
301      Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.)
302      Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn)
303      Agrif_UseSpecialValue = .FALSE.
304
305      ! 3. Some controls
306      !-----------------
307      check_namelist = .true.
308           
309      IF( check_namelist ) THEN
310#  if defined offline     
311         ! Check time steps
312         IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
313            WRITE(*,*) 'incompatible time step between grids'
314            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
315            WRITE(*,*) 'child  grid value : ',nint(rdt)
316            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
317            STOP
318         ENDIF
319
320         ! Check run length
321         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
322            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
323            WRITE(*,*) 'incompatible run length between grids'
324            WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
325               Agrif_Parent(nit000)+1),' time step'
326            WRITE(*,*) 'child  grid value : ', &
327               (nitend-nit000+1),' time step'
328            WRITE(*,*) 'value on child grid should be : ', &
329               Agrif_IRhot() * (Agrif_Parent(nitend)- &
330               Agrif_Parent(nit000)+1)
331            STOP
332         ENDIF
333         
334         ! Check coordinates
335         IF( ln_zps ) THEN
336            ! check parameters for partial steps
337            IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
338               WRITE(*,*) 'incompatible e3zps_min between grids'
339               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
340               WRITE(*,*) 'child grid  :',e3zps_min
341               WRITE(*,*) 'those values should be identical'
342               STOP
343            ENDIF         
344            IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
345               WRITE(*,*) 'incompatible e3zps_rat between grids'
346               WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
347               WRITE(*,*) 'child grid  :',e3zps_rat
348               WRITE(*,*) 'those values should be identical'                 
349               STOP
350            ENDIF
351         ENDIF
352#  endif         
353        ! Check passive tracer cell
354        IF( nn_dttrc .ne. 1 ) THEN
355           WRITE(*,*) 'nn_dttrc should be equal to 1'
356        ENDIF
357      ENDIF
358       
359      CALL Agrif_Update_trc(0)
360      nbcline_trc = 0
361      !
362      DEALLOCATE(tabtrtemp)
363      !
364   END SUBROUTINE Agrif_InitValues_cont_top
365
366
367   SUBROUTINE agrif_declare_var_top
368      !!----------------------------------------------------------------------
369      !!                 *** ROUTINE agrif_declare_var_top ***
370      !!
371      !! ** Purpose :: Declaration of TOP variables to be interpolated
372      !!----------------------------------------------------------------------
373      USE agrif_util
374      USE dom_oce
375      USE trc
376     
377      IMPLICIT NONE
378   
379      ! 1. Declaration of the type of variable which have to be interpolated
380      !---------------------------------------------------------------------
381      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)
382      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)
383      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)
384#  if defined key_offline
385      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
386      CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
387#  endif
388       
389      ! 2. Type of interpolation
390      !-------------------------
391      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
392      CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear)
393   
394#  if defined key_offline
395      Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
396      Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
397#  endif
398
399      ! 3. Location of interpolation
400      !-----------------------------
401#  if defined key_offline
402      Call Agrif_Set_bc(e1u_id,(/0,0/))
403      Call Agrif_Set_bc(e2v_id,(/0,0/))
404#  endif
405      Call Agrif_Set_bc(trn_id,(/0,1/))
406      Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/))
407
408      ! 5. Update type
409      !---------------
410      Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
411      Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average)
412
413#  if defined key_offline
414      Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
415      Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
416#  endif
417
418   END SUBROUTINE agrif_declare_var_top
419# endif
420   
421   SUBROUTINE Agrif_detect( kg, ksizex )
422      !!----------------------------------------------------------------------
423      !!   *** ROUTINE Agrif_detect ***
424      !!----------------------------------------------------------------------
425      USE Agrif_Types
426      !
427      INTEGER, DIMENSION(2) :: ksizex
428      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
429      !!----------------------------------------------------------------------
430      !
431      RETURN
432      !
433   END SUBROUTINE Agrif_detect
434
435
436   SUBROUTINE agrif_nemo_init
437      !!----------------------------------------------------------------------
438      !!                     *** ROUTINE agrif_init ***
439      !!----------------------------------------------------------------------
440      USE agrif_oce 
441      USE in_out_manager
442      USE lib_mpp
443      IMPLICIT NONE
444      !
445      NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
446      !!----------------------------------------------------------------------
447      !
448      REWIND( numnam )                ! Read namagrif namelist
449      READ  ( numnam, namagrif )
450      !
451      IF(lwp) THEN                    ! control print
452         WRITE(numout,*)
453         WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
454         WRITE(numout,*) '~~~~~~~~~~~~~~~'
455         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
456         WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
457         WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
458         WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
459         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
460         WRITE(numout,*) 
461      ENDIF
462      !
463      ! convert DOCTOR namelist name into OLD names
464      nbclineupdate = nn_cln_update
465      visc_tra      = rn_sponge_tra
466      visc_dyn      = rn_sponge_dyn
467      !
468      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed')
469      !
470    END SUBROUTINE agrif_nemo_init
471
472# if defined key_mpp_mpi
473
474   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
475      !!----------------------------------------------------------------------
476      !!                     *** ROUTINE Agrif_detect ***
477      !!----------------------------------------------------------------------
478      USE dom_oce
479      IMPLICIT NONE
480      !
481      INTEGER :: indglob, indloc, nprocloc, i
482      !!----------------------------------------------------------------------
483      !
484      SELECT CASE( i )
485      CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
486      CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
487      CASE(3)   ;   indglob = indloc
488      CASE(4)   ;   indglob = indloc
489      END SELECT
490      !
491   END SUBROUTINE Agrif_InvLoc
492
493# endif
494
495#else
496   SUBROUTINE Subcalledbyagrif
497      !!----------------------------------------------------------------------
498      !!                   *** ROUTINE Subcalledbyagrif ***
499      !!----------------------------------------------------------------------
500      WRITE(*,*) 'Impossible to be here'
501   END SUBROUTINE Subcalledbyagrif
502#endif
Note: See TracBrowser for help on using the repository browser.