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

source: utils/tools/DOMAINcfg/src/agrif_user.F90 @ 12414

Last change on this file since 12414 was 12414, checked in by smueller, 4 years ago

Reintegration of 2019 development branch /utils/tools_MERGE_2019 into the tools directory (/utils/tools)

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