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

Context Navigation

source: branches/DEV_r1879_FCM/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 2007

Last change on this file since 2007 was 2007, checked in by smasson, 14 years ago
update branches/DEV_r1879_FCM/NEMOGCM/NEMO with tags/nemo_v3_2_1/NEMO
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 18.9 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: