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 utils/tools_AGRIF_CMEMS_2020/DOMAINcfg/src – NEMO

source: utils/tools_AGRIF_CMEMS_2020/DOMAINcfg/src/agrif_user.F90 @ 10727

Last change on this file since 10727 was 10727, checked in by rblod, 5 years ago

new nesting tools (attempt) and brutal cleaning of DOMAINcfg, see ticket #2129
File size: 32.9 KB
Line 
1#if defined key_agrif
2subroutine agrif_initworkspace()
3      !!----------------------------------------------------------------------
4      !!                 *** ROUTINE Agrif_InitWorkspace ***
5      !!----------------------------------------------------------------------
6end subroutine agrif_initworkspace
7SUBROUTINE Agrif_InitValues
8      !!----------------------------------------------------------------------
9      !!                 *** ROUTINE Agrif_InitValues ***
10      !!
11      !! ** Purpose :: Declaration of variables to be interpolated
12      !!----------------------------------------------------------------------
13   USE Agrif_Util
14   USE oce 
15   USE dom_oce
16   USE nemogcm
17   USE domain
18   !!
19   IMPLICIT NONE
20   
21 
22   CALL nemo_init       !* Initializations of each fine grid
23
24   CALL dom_nam
25   CALL cfg_write         ! create the configuration file
26   
27END SUBROUTINE Agrif_InitValues
28
29SUBROUTINE Agrif_InitValues_cont
30
31use dom_oce
32    integer :: irafx, irafy
33    logical :: ln_perio
34    integer nx,ny
35
36irafx = agrif_irhox()
37irafy = agrif_irhoy()
38
39nx=nlci ; ny=nlcj
40
41   !       IF(jperio /=1 .AND. jperio/=4 .AND. jperio/=6 ) THEN
42   !          nx = (nbcellsx)+2*nbghostcellsfine+2
43   !          ny = (nbcellsy)+2*nbghostcellsfine+2
44   !          nbghostcellsfine_tot_x= nbghostcellsfine_x +1
45   !          nbghostcellsfine_tot_y= nbghostcellsfine_y +1
46   !       ELSE
47   !         nx = (nbcellsx)+2*nbghostcellsfine_x
48   !         ny = (nbcellsy)+2*nbghostcellsfine+2
49   !         nbghostcellsfine_tot_x= 1
50   !         nbghostcellsfine_tot_y= nbghostcellsfine_y +1
51   !      ENDIF
52   !    ELSE
53   !       nbghostcellsfine = 0
54   !       nx = nbcellsx+irafx
55   !       ny = nbcellsy+irafy
56       
57  WRITE(*,*) ' '
58  WRITE(*,*)'Size of the High resolution grid: ',nx,' x ',ny
59  WRITE(*,*) ' '
60       
61       call agrif_init_lonlat()
62       ln_perio=.FALSE. 
63       if( jperio ==1 .OR. jperio==2 .OR. jperio==4) ln_perio=.TRUE.
64
65       where (glamt < -180) glamt = glamt +360.
66       if (ln_perio) then
67         glamt(1,:)=glamt(nx-1,:)
68         glamt(nx,:)=glamt(2,:)
69       endif
70 
71       where (glamu < -180) glamu = glamu +360.
72       if (ln_perio) then
73         glamu(1,:)=glamu(nx-1,:)
74         glamu(nx,:)=glamu(2,:)
75       endif
76
77      where (glamv < -180) glamv = glamv +360.
78       if (ln_perio) then
79         glamv(1,:)=glamv(nx-1,:)
80         glamv(nx,:)=glamv(2,:)
81       endif
82
83      where (glamf < -180) glamf = glamf +360.
84       if (ln_perio) then
85         glamf(1,:)=glamf(nx-1,:)
86         glamf(nx,:)=glamf(2,:)
87       endif
88
89       call agrif_init_scales()
90
91       
92END SUBROUTINE Agrif_InitValues_cont 
93
94
95subroutine agrif_declare_var()
96use par_oce
97use dom_oce
98use agrif_profiles
99use agrif_parameters
100
101   IMPLICIT NONE
102   
103integer :: ind1, ind2, ind3
104integer nx,ny
105integer nbghostcellsfine_tot_x, nbghostcellsfine_tot_y
106INTEGER :: irafx
107!!----------------------------------------------------------------------
108
109   ! 1. Declaration of the type of variable which have to be interpolated
110   !---------------------------------------------------------------------
111 nx=nlci ; ny=nlcj
112
113!ind2 = nbghostcellsfine_tot_x + 1
114!ind3 = nbghostcellsfine_tot_y + 1
115ind2 = 2 + nbghostcells
116ind3 = ind2
117nbghostcellsfine_tot_x=nbghostcells+1
118nbghostcellsfine_tot_y=nbghostcells+1
119
120irafx = Agrif_irhox()
121
122CALL agrif_nemo_init  ! specific namelist part if needed
123
124CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),glamt_id)
125CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),glamu_id)
126CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),glamv_id)
127CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),glamf_id)
128
129CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),gphit_id)
130CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),gphiu_id)
131CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),gphiv_id)
132CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),gphif_id)
133
134! Horizontal scale factors
135
136CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e1t_id)
137CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e1u_id)
138CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e1v_id)
139CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e1f_id)
140
141CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e2t_id)
142CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e2u_id)
143CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e2v_id)
144CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e2f_id)
145
146! Bathymetry
147
148CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),bathy_id)
149
150! Vertical scale factors
151CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3t_id)
152CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3t_copy_id)
153CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk+1/),e3t_connect_id)
154
155CALL agrif_declare_variable((/1,2,0/),(/ind2-1,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3u_id)
156CALL agrif_declare_variable((/2,1,0/),(/ind2,ind3-1,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3v_id)
157
158! Bottom level
159
160CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),bottom_level_id)
161
162CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_linear)
163CALL Agrif_Set_interp(glamt_id,interp=AGRIF_linear)
164CALL Agrif_Set_bc( glamt_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
165
166CALL Agrif_Set_bcinterp(glamu_id,interp=AGRIF_linear)
167CALL Agrif_Set_interp(glamu_id,interp=AGRIF_linear)
168CALL Agrif_Set_bc( glamu_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
169
170CALL Agrif_Set_bcinterp(glamv_id,interp=AGRIF_linear)
171CALL Agrif_Set_interp(glamv_id,interp=AGRIF_linear)
172CALL Agrif_Set_bc( glamv_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
173
174CALL Agrif_Set_bcinterp(glamf_id,interp=AGRIF_linear)
175CALL Agrif_Set_interp(glamf_id,interp=AGRIF_linear)
176CALL Agrif_Set_bc( glamf_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
177
178CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_linear)
179CALL Agrif_Set_interp(gphit_id,interp=AGRIF_linear)
180CALL Agrif_Set_bc( gphit_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
181
182CALL Agrif_Set_bcinterp(gphiu_id,interp=AGRIF_linear)
183CALL Agrif_Set_interp(gphiu_id,interp=AGRIF_linear)
184CALL Agrif_Set_bc( gphiu_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
185
186CALL Agrif_Set_bcinterp(gphiv_id,interp=AGRIF_linear)
187CALL Agrif_Set_interp(gphiv_id,interp=AGRIF_linear)
188CALL Agrif_Set_bc( gphiv_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
189
190CALL Agrif_Set_bcinterp(gphif_id,interp=AGRIF_linear)
191CALL Agrif_Set_interp(gphif_id,interp=AGRIF_linear)
192CALL Agrif_Set_bc( gphif_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
193
194!
195
196CALL Agrif_Set_bcinterp(e1t_id,interp=AGRIF_ppm)
197CALL Agrif_Set_interp(e1t_id,interp=AGRIF_ppm)
198CALL Agrif_Set_bc( e1t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
199
200CALL Agrif_Set_bcinterp(e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
201CALL Agrif_Set_interp(e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
202CALL Agrif_Set_bc( e1u_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
203
204CALL Agrif_Set_bcinterp(e1v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
205CALL Agrif_Set_interp(e1v_id, interp1=AGRIF_ppm, interp2=Agrif_linear)
206CALL Agrif_Set_bc( e1v_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
207
208CALL Agrif_Set_bcinterp(e1f_id,interp=AGRIF_linear)
209CALL Agrif_Set_interp(e1f_id,interp=AGRIF_linear)
210CALL Agrif_Set_bc( e1f_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
211
212CALL Agrif_Set_bcinterp(e2t_id,interp=AGRIF_ppm)
213CALL Agrif_Set_interp(e2t_id,interp=AGRIF_ppm)
214CALL Agrif_Set_bc( e2t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
215
216CALL Agrif_Set_bcinterp(e2u_id,interp1=Agrif_linear, interp2=AGRIF_ppm)
217CALL Agrif_Set_interp(e2u_id,interp1=Agrif_linear, interp2=AGRIF_ppm)
218CALL Agrif_Set_bc( e2u_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
219
220CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
221CALL Agrif_Set_interp(e2v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
222CALL Agrif_Set_bc( e2v_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
223
224CALL Agrif_Set_bcinterp(e2f_id,interp=AGRIF_linear)
225CALL Agrif_Set_interp(e2f_id,interp=AGRIF_linear)
226CALL Agrif_Set_bc( e2f_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
227
228CALL Agrif_Set_bcinterp(bathy_id,interp=AGRIF_linear)
229CALL Agrif_Set_interp(bathy_id,interp=AGRIF_linear)
230CALL Agrif_Set_bc( bathy_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
231
232! Vertical scale factors
233CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_ppm)
234CALL Agrif_Set_interp(e3t_id,interp=AGRIF_ppm)
235CALL Agrif_Set_bc( e3t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
236CALL Agrif_Set_Updatetype( e3t_id, update = AGRIF_Update_Average)
237
238CALL Agrif_Set_bcinterp(e3t_copy_id,interp=AGRIF_constant)
239CALL Agrif_Set_interp(e3t_copy_id,interp=AGRIF_constant)
240CALL Agrif_Set_bc( e3t_copy_id, (/-npt_copy*irafx-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
241
242CALL Agrif_Set_bcinterp(e3t_connect_id,interp=AGRIF_ppm)
243CALL Agrif_Set_interp(e3t_connect_id,interp=AGRIF_ppm)
244CALL Agrif_Set_bc( e3t_connect_id, (/-(npt_copy+npt_connect)*irafx-1,-npt_copy*irafx-2/))
245
246CALL Agrif_Set_bcinterp(e3u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
247CALL Agrif_Set_interp(e3u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
248CALL Agrif_Set_bc( e3u_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
249CALL Agrif_Set_Updatetype(e3u_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
250
251CALL Agrif_Set_bcinterp(e3v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
252CALL Agrif_Set_interp(e3v_id, interp1=AGRIF_ppm, interp2=Agrif_linear)
253CALL Agrif_Set_bc( e3v_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
254CALL Agrif_Set_Updatetype(e3v_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
255   
256! Bottom level
257CALL Agrif_Set_bcinterp(bottom_level_id,interp=AGRIF_constant)
258CALL Agrif_Set_interp(bottom_level_id,interp=AGRIF_constant)
259CALL Agrif_Set_bc( bottom_level_id, (/-npt_copy*irafx-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
260CALL Agrif_Set_Updatetype( bottom_level_id, update = AGRIF_Update_Max)
261
262end subroutine agrif_declare_var
263
264
265subroutine agrif_init_lonlat()
266use agrif_profiles
267use agrif_util
268external :: init_glamt, init_glamu, init_glamv, init_glamf
269external :: init_gphit, init_gphiu, init_gphiv, init_gphif
270
271call Agrif_Init_variable(glamt_id, procname = init_glamt)
272call Agrif_Init_variable(glamu_id, procname = init_glamu)
273call Agrif_Init_variable(glamv_id, procname = init_glamv)
274call Agrif_Init_variable(glamf_id, procname = init_glamf)
275
276call Agrif_Init_variable(gphit_id, procname = init_gphit)
277call Agrif_Init_variable(gphiu_id, procname = init_gphiu)
278call Agrif_Init_variable(gphiv_id, procname = init_gphiv)
279call Agrif_Init_variable(gphif_id, procname = init_gphif)
280
281end subroutine agrif_init_lonlat
282
283subroutine agrif_init_scales()
284use agrif_profiles
285use agrif_util
286external :: init_e1t, init_e1u, init_e1v, init_e1f
287external :: init_e2t, init_e2u, init_e2v, init_e2f
288
289call Agrif_Init_variable(e1t_id, procname = init_e1t)
290call Agrif_Init_variable(e1u_id, procname = init_e1u)
291call Agrif_Init_variable(e1v_id, procname = init_e1v)
292call Agrif_Init_variable(e1f_id, procname = init_e1f)
293
294call Agrif_Init_variable(e2t_id, procname = init_e2t)
295call Agrif_Init_variable(e2u_id, procname = init_e2u)
296call Agrif_Init_variable(e2v_id, procname = init_e2v)
297call Agrif_Init_variable(e2f_id, procname = init_e2f)
298
299end subroutine agrif_init_scales
300
301
302
303   SUBROUTINE init_glamt( ptab, i1, i2, j1, j2, before, nb,ndir)
304   use dom_oce
305      !!----------------------------------------------------------------------
306      !!                  ***  ROUTINE interpsshn  ***
307      !!---------------------------------------------------------------------- 
308      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
309      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
310      LOGICAL                         , INTENT(in   ) ::   before
311      INTEGER                         , INTENT(in   ) ::   nb , ndir
312      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
313      !
314      !!---------------------------------------------------------------------- 
315      !
316         western_side  = (nb == 1).AND.(ndir == 1)
317         eastern_side  = (nb == 1).AND.(ndir == 2)
318         southern_side = (nb == 2).AND.(ndir == 1)
319         northern_side = (nb == 2).AND.(ndir == 2)
320      IF( before) THEN
321         ptab(i1:i2,j1:j2) = glamt(i1:i2,j1:j2)
322      ELSE
323         glamt(i1:i2,j1:j2)=ptab
324      ENDIF
325      !
326   END SUBROUTINE init_glamt
327
328    SUBROUTINE init_glamu( ptab, i1, i2, j1, j2, before, nb,ndir)
329    use dom_oce
330      !!----------------------------------------------------------------------
331      !!                  ***  ROUTINE interpsshn  ***
332      !!---------------------------------------------------------------------- 
333      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
334      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
335      LOGICAL                         , INTENT(in   ) ::   before
336      INTEGER                         , INTENT(in   ) ::   nb , ndir
337      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
338      !
339      !!---------------------------------------------------------------------- 
340      !
341         western_side  = (nb == 1).AND.(ndir == 1)
342         eastern_side  = (nb == 1).AND.(ndir == 2)
343         southern_side = (nb == 2).AND.(ndir == 1)
344         northern_side = (nb == 2).AND.(ndir == 2)
345      IF( before) THEN
346         ptab(i1:i2,j1:j2) = glamu(i1:i2,j1:j2)
347      ELSE
348         glamu(i1:i2,j1:j2)=ptab
349      ENDIF
350      !
351   END SUBROUTINE init_glamu
352
353   SUBROUTINE init_glamv( ptab, i1, i2, j1, j2, before, nb,ndir)
354   use dom_oce
355      !!----------------------------------------------------------------------
356      !!                  ***  ROUTINE interpsshn  ***
357      !!---------------------------------------------------------------------- 
358      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
359      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
360      LOGICAL                         , INTENT(in   ) ::   before
361      INTEGER                         , INTENT(in   ) ::   nb , ndir
362      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
363      !
364      !!---------------------------------------------------------------------- 
365      !
366         western_side  = (nb == 1).AND.(ndir == 1)
367         eastern_side  = (nb == 1).AND.(ndir == 2)
368         southern_side = (nb == 2).AND.(ndir == 1)
369         northern_side = (nb == 2).AND.(ndir == 2)
370      IF( before) THEN
371         ptab(i1:i2,j1:j2) = glamv(i1:i2,j1:j2)
372      ELSE
373         glamv(i1:i2,j1:j2)=ptab
374      ENDIF
375      !
376   END SUBROUTINE init_glamv
377
378   SUBROUTINE init_glamf( ptab, i1, i2, j1, j2, before, nb,ndir)
379   use dom_oce
380      !!----------------------------------------------------------------------
381      !!                  ***  ROUTINE interpsshn  ***
382      !!---------------------------------------------------------------------- 
383      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
384      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
385      LOGICAL                         , INTENT(in   ) ::   before
386      INTEGER                         , INTENT(in   ) ::   nb , ndir
387      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
388      !
389      !!---------------------------------------------------------------------- 
390      !
391         western_side  = (nb == 1).AND.(ndir == 1)
392         eastern_side  = (nb == 1).AND.(ndir == 2)
393         southern_side = (nb == 2).AND.(ndir == 1)
394         northern_side = (nb == 2).AND.(ndir == 2)
395      IF( before) THEN
396         ptab(i1:i2,j1:j2) = glamf(i1:i2,j1:j2)
397      ELSE
398         glamf(i1:i2,j1:j2)=ptab
399      ENDIF
400      !
401   END SUBROUTINE init_glamf
402
403   SUBROUTINE init_gphit( ptab, i1, i2, j1, j2, before, nb,ndir)
404   use dom_oce
405      !!----------------------------------------------------------------------
406      !!                  ***  ROUTINE interpsshn  ***
407      !!---------------------------------------------------------------------- 
408      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
409      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
410      LOGICAL                         , INTENT(in   ) ::   before
411      INTEGER                         , INTENT(in   ) ::   nb , ndir
412      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
413      !
414      !!---------------------------------------------------------------------- 
415      !
416         western_side  = (nb == 1).AND.(ndir == 1)
417         eastern_side  = (nb == 1).AND.(ndir == 2)
418         southern_side = (nb == 2).AND.(ndir == 1)
419         northern_side = (nb == 2).AND.(ndir == 2)
420      IF( before) THEN
421         ptab(i1:i2,j1:j2) = gphit(i1:i2,j1:j2)
422      ELSE
423         gphit(i1:i2,j1:j2)=ptab
424      ENDIF
425      !
426   END SUBROUTINE init_gphit
427
428    SUBROUTINE init_gphiu( ptab, i1, i2, j1, j2, before, nb,ndir)
429    use dom_oce
430      !!----------------------------------------------------------------------
431      !!                  ***  ROUTINE interpsshn  ***
432      !!---------------------------------------------------------------------- 
433      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
434      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
435      LOGICAL                         , INTENT(in   ) ::   before
436      INTEGER                         , INTENT(in   ) ::   nb , ndir
437      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
438      !
439      !!---------------------------------------------------------------------- 
440      !
441         western_side  = (nb == 1).AND.(ndir == 1)
442         eastern_side  = (nb == 1).AND.(ndir == 2)
443         southern_side = (nb == 2).AND.(ndir == 1)
444         northern_side = (nb == 2).AND.(ndir == 2)
445      IF( before) THEN
446         ptab(i1:i2,j1:j2) = gphiu(i1:i2,j1:j2)
447      ELSE
448         gphiu(i1:i2,j1:j2)=ptab
449      ENDIF
450      !
451   END SUBROUTINE init_gphiu
452
453    SUBROUTINE init_gphiv( ptab, i1, i2, j1, j2, before, nb,ndir)
454    use dom_oce
455      !!----------------------------------------------------------------------
456      !!                  ***  ROUTINE interpsshn  ***
457      !!---------------------------------------------------------------------- 
458      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
459      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
460      LOGICAL                         , INTENT(in   ) ::   before
461      INTEGER                         , INTENT(in   ) ::   nb , ndir
462      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
463      !
464      !!---------------------------------------------------------------------- 
465      !
466         western_side  = (nb == 1).AND.(ndir == 1)
467         eastern_side  = (nb == 1).AND.(ndir == 2)
468         southern_side = (nb == 2).AND.(ndir == 1)
469         northern_side = (nb == 2).AND.(ndir == 2)
470      IF( before) THEN
471         ptab(i1:i2,j1:j2) = gphiv(i1:i2,j1:j2)
472      ELSE
473         gphiv(i1:i2,j1:j2)=ptab
474      ENDIF
475      !
476   END SUBROUTINE init_gphiv
477
478
479   SUBROUTINE init_gphif( ptab, i1, i2, j1, j2, before, nb,ndir)
480   use dom_oce
481      !!----------------------------------------------------------------------
482      !!                  ***  ROUTINE interpsshn  ***
483      !!---------------------------------------------------------------------- 
484      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
485      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
486      LOGICAL                         , INTENT(in   ) ::   before
487      INTEGER                         , INTENT(in   ) ::   nb , ndir
488      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
489      !
490      !!---------------------------------------------------------------------- 
491      !
492         western_side  = (nb == 1).AND.(ndir == 1)
493         eastern_side  = (nb == 1).AND.(ndir == 2)
494         southern_side = (nb == 2).AND.(ndir == 1)
495         northern_side = (nb == 2).AND.(ndir == 2)
496      IF( before) THEN
497         ptab(i1:i2,j1:j2) = gphif(i1:i2,j1:j2)
498      ELSE
499         gphif(i1:i2,j1:j2)=ptab
500      ENDIF
501      !
502   END SUBROUTINE init_gphif
503
504
505   SUBROUTINE init_e1t( ptab, i1, i2, j1, j2, before, nb,ndir)
506   use dom_oce
507      !!----------------------------------------------------------------------
508      !!                  ***  ROUTINE interpsshn  ***
509      !!---------------------------------------------------------------------- 
510      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
511      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
512      LOGICAL                         , INTENT(in   ) ::   before
513      INTEGER                         , INTENT(in   ) ::   nb , ndir
514      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
515      !
516      !!---------------------------------------------------------------------- 
517      !
518         western_side  = (nb == 1).AND.(ndir == 1)
519         eastern_side  = (nb == 1).AND.(ndir == 2)
520         southern_side = (nb == 2).AND.(ndir == 1)
521         northern_side = (nb == 2).AND.(ndir == 2)
522      IF( before) THEN
523         ptab(i1:i2,j1:j2) = e1t(i1:i2,j1:j2)
524      ELSE
525         e1t(i1:i2,j1:j2)=ptab/Agrif_rhoy()
526      ENDIF
527      !
528   END SUBROUTINE init_e1t
529
530   SUBROUTINE init_e1u( ptab, i1, i2, j1, j2, before, nb,ndir)
531   use dom_oce
532      !!----------------------------------------------------------------------
533      !!                  ***  ROUTINE interpsshn  ***
534      !!---------------------------------------------------------------------- 
535      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
536      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
537      LOGICAL                         , INTENT(in   ) ::   before
538      INTEGER                         , INTENT(in   ) ::   nb , ndir
539      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
540      !
541      !!---------------------------------------------------------------------- 
542      !
543         western_side  = (nb == 1).AND.(ndir == 1)
544         eastern_side  = (nb == 1).AND.(ndir == 2)
545         southern_side = (nb == 2).AND.(ndir == 1)
546         northern_side = (nb == 2).AND.(ndir == 2)
547      IF( before) THEN
548         ptab(i1:i2,j1:j2) = e1u(i1:i2,j1:j2)
549      ELSE
550         e1u(i1:i2,j1:j2)=ptab/Agrif_rhoy()
551      ENDIF
552      !
553   END SUBROUTINE init_e1u
554
555   SUBROUTINE init_e1v( ptab, i1, i2, j1, j2, before, nb,ndir)
556   use dom_oce
557      !!----------------------------------------------------------------------
558      !!                  ***  ROUTINE interpsshn  ***
559      !!---------------------------------------------------------------------- 
560      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
561      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
562      LOGICAL                         , INTENT(in   ) ::   before
563      INTEGER                         , INTENT(in   ) ::   nb , ndir
564      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
565      !
566      !!---------------------------------------------------------------------- 
567      !
568         western_side  = (nb == 1).AND.(ndir == 1)
569         eastern_side  = (nb == 1).AND.(ndir == 2)
570         southern_side = (nb == 2).AND.(ndir == 1)
571         northern_side = (nb == 2).AND.(ndir == 2)
572      IF( before) THEN
573         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2)
574      ELSE
575         e1v(i1:i2,j1:j2)=ptab/Agrif_rhoy()
576      ENDIF
577      !
578   END SUBROUTINE init_e1v
579
580   SUBROUTINE init_e1f( ptab, i1, i2, j1, j2, before, nb,ndir)
581   use dom_oce
582      !!----------------------------------------------------------------------
583      !!                  ***  ROUTINE interpsshn  ***
584      !!---------------------------------------------------------------------- 
585      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
586      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
587      LOGICAL                         , INTENT(in   ) ::   before
588      INTEGER                         , INTENT(in   ) ::   nb , ndir
589      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
590      !
591      !!---------------------------------------------------------------------- 
592      !
593         western_side  = (nb == 1).AND.(ndir == 1)
594         eastern_side  = (nb == 1).AND.(ndir == 2)
595         southern_side = (nb == 2).AND.(ndir == 1)
596         northern_side = (nb == 2).AND.(ndir == 2)
597      IF( before) THEN
598         ptab(i1:i2,j1:j2) = e1f(i1:i2,j1:j2)
599      ELSE
600         e1f(i1:i2,j1:j2)=ptab/Agrif_rhoy()
601      ENDIF
602      !
603   END SUBROUTINE init_e1f
604
605  SUBROUTINE init_e2t( ptab, i1, i2, j1, j2, before, nb,ndir)
606   use dom_oce
607      !!----------------------------------------------------------------------
608      !!                  ***  ROUTINE interpsshn  ***
609      !!---------------------------------------------------------------------- 
610      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
611      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
612      LOGICAL                         , INTENT(in   ) ::   before
613      INTEGER                         , INTENT(in   ) ::   nb , ndir
614      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
615      !
616      !!---------------------------------------------------------------------- 
617      !
618         western_side  = (nb == 1).AND.(ndir == 1)
619         eastern_side  = (nb == 1).AND.(ndir == 2)
620         southern_side = (nb == 2).AND.(ndir == 1)
621         northern_side = (nb == 2).AND.(ndir == 2)
622      IF( before) THEN
623         ptab(i1:i2,j1:j2) = e2t(i1:i2,j1:j2)
624      ELSE
625         e2t(i1:i2,j1:j2)=ptab/Agrif_rhoy()
626      ENDIF
627      !
628   END SUBROUTINE init_e2t
629
630   SUBROUTINE init_e2u( ptab, i1, i2, j1, j2, before, nb,ndir)
631   use dom_oce
632      !!----------------------------------------------------------------------
633      !!                  ***  ROUTINE interpsshn  ***
634      !!---------------------------------------------------------------------- 
635      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
636      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
637      LOGICAL                         , INTENT(in   ) ::   before
638      INTEGER                         , INTENT(in   ) ::   nb , ndir
639      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
640      !
641      !!---------------------------------------------------------------------- 
642      !
643         western_side  = (nb == 1).AND.(ndir == 1)
644         eastern_side  = (nb == 1).AND.(ndir == 2)
645         southern_side = (nb == 2).AND.(ndir == 1)
646         northern_side = (nb == 2).AND.(ndir == 2)
647      IF( before) THEN
648         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2)
649      ELSE
650         e2u(i1:i2,j1:j2)=ptab/Agrif_rhoy()
651      ENDIF
652      !
653   END SUBROUTINE init_e2u
654
655   SUBROUTINE init_e2v( ptab, i1, i2, j1, j2, before, nb,ndir)
656   use dom_oce
657      !!----------------------------------------------------------------------
658      !!                  ***  ROUTINE interpsshn  ***
659      !!---------------------------------------------------------------------- 
660      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
661      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
662      LOGICAL                         , INTENT(in   ) ::   before
663      INTEGER                         , INTENT(in   ) ::   nb , ndir
664      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
665      !
666      !!---------------------------------------------------------------------- 
667      !
668         western_side  = (nb == 1).AND.(ndir == 1)
669         eastern_side  = (nb == 1).AND.(ndir == 2)
670         southern_side = (nb == 2).AND.(ndir == 1)
671         northern_side = (nb == 2).AND.(ndir == 2)
672      IF( before) THEN
673         ptab(i1:i2,j1:j2) = e2v(i1:i2,j1:j2)
674      ELSE
675         e2v(i1:i2,j1:j2)=ptab/Agrif_rhoy()
676      ENDIF
677      !
678   END SUBROUTINE init_e2v
679
680   SUBROUTINE init_e2f( ptab, i1, i2, j1, j2, before, nb,ndir)
681   use dom_oce
682      !!----------------------------------------------------------------------
683      !!                  ***  ROUTINE interpsshn  ***
684      !!---------------------------------------------------------------------- 
685      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
686      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
687      LOGICAL                         , INTENT(in   ) ::   before
688      INTEGER                         , INTENT(in   ) ::   nb , ndir
689      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
690      !
691      !!---------------------------------------------------------------------- 
692      !
693         western_side  = (nb == 1).AND.(ndir == 1)
694         eastern_side  = (nb == 1).AND.(ndir == 2)
695         southern_side = (nb == 2).AND.(ndir == 1)
696         northern_side = (nb == 2).AND.(ndir == 2)
697      IF( before) THEN
698         ptab(i1:i2,j1:j2) = e2f(i1:i2,j1:j2)
699      ELSE
700         e2f(i1:i2,j1:j2)=ptab/Agrif_rhoy()
701      ENDIF
702      !
703   END SUBROUTINE init_e2f
704
705
706SUBROUTINE agrif_nemo_init
707USE agrif_parameters
708USE in_out_manager
709USE lib_mpp
710
711   
712   !!
713   IMPLICIT NONE
714   
715   INTEGER ::   ios
716   
717   NAMELIST/namagrif/ nn_cln_update,ln_spc_dyn,rn_sponge_tra,rn_sponge_dyn,ln_chk_bathy,npt_connect, npt_copy
718
719      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : nesting parameters
720      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901 )
721901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
722
723      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : nesting parameters
724      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
725902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
726      IF(lwm) WRITE ( numond, namagrif )
727
728      IF(lwp) THEN                     ! Control print
729         WRITE(numout,*)
730         WRITE(numout,*) 'agrif_nemo_init : nesting'
731         WRITE(numout,*) '~~~~~~~'
732         WRITE(numout,*) '   Namelist namagrif : set nesting parameters'
733         WRITE(numout,*) '      npt_copy     = ', npt_copy
734         WRITE(numout,*) '      npt_connect  = ', npt_connect
735      ENDIF
736     
737END SUBROUTINE agrif_nemo_init
738   
739
740SUBROUTINE Agrif_detect( kg, ksizex )
741      !!----------------------------------------------------------------------
742      !!                      *** ROUTINE Agrif_detect ***
743      !!----------------------------------------------------------------------
744   INTEGER, DIMENSION(2) :: ksizex
745   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
746      !!----------------------------------------------------------------------
747   !
748   RETURN
749   !
750END SUBROUTINE Agrif_detect
751SUBROUTINE agrif_before_regridding
752END SUBROUTINE agrif_before_regridding
753
754SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
755      !!----------------------------------------------------------------------
756      !!                     *** ROUTINE Agrif_InvLoc ***
757      !!----------------------------------------------------------------------
758   USE dom_oce
759   !!
760   IMPLICIT NONE
761   !
762   INTEGER :: indglob, indloc, nprocloc, i
763      !!----------------------------------------------------------------------
764   !
765   SELECT CASE( i )
766   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
767   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
768   CASE DEFAULT
769      indglob = indloc
770   END SELECT
771   !
772END SUBROUTINE Agrif_InvLoc
773
774SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
775      !!----------------------------------------------------------------------
776      !!                 *** ROUTINE Agrif_get_proc_info ***
777      !!----------------------------------------------------------------------
778   USE par_oce
779   USE dom_oce 
780   !!
781   IMPLICIT NONE
782   !
783   INTEGER, INTENT(out) :: imin, imax
784   INTEGER, INTENT(out) :: jmin, jmax
785      !!----------------------------------------------------------------------
786   !
787   imin = nimppt(Agrif_Procrank+1)  ! ?????
788   jmin = njmppt(Agrif_Procrank+1)  ! ?????
789   imax = imin + jpi - 1
790   jmax = jmin + jpj - 1
791   !
792END SUBROUTINE Agrif_get_proc_info
793
794SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
795      !!----------------------------------------------------------------------
796      !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
797      !!----------------------------------------------------------------------
798   USE par_oce
799   !!
800   IMPLICIT NONE
801   !
802   INTEGER,  INTENT(in)  :: imin, imax
803   INTEGER,  INTENT(in)  :: jmin, jmax
804   INTEGER,  INTENT(in)  :: nbprocs
805   REAL(wp), INTENT(out) :: grid_cost
806      !!----------------------------------------------------------------------
807   !
808   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
809   !
810END SUBROUTINE Agrif_estimate_parallel_cost
811
812#endif
Note: See TracBrowser for help on using the repository browser.