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

source: branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 2789

Last change on this file since 2789 was 2789, checked in by cetlod, 13 years ago

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