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

Context Navigation

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 2287

Last change on this file since 2287 was 2287, checked in by smasson, 14 years ago
update licence of all NEMO files...
Property svn:keywords set to `Id`
File size: 18.9 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
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_offline
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	! Specific fine grid Initializations
104	#if defined key_tradmp \|\| defined key_esopa
105	! no tracer damping on fine grids
106	lk_tradmp = .FALSE.
107	#endif
108	#if defined key_obc \|\| defined key_esopa
109	! no open boundary on fine grids
110	lk_obc = .FALSE.
111	#endif
112
113	Call opa_init ! Initializations of each fine grid
114	Call agrif_opa_init
115
116	! 1. Declaration of the type of variable which have to be interpolated
117	!---------------------------------------------------------------------
118	Call Agrif_Set_type(un,(/1,2,0/),(/2,3,0/))
119	Call Agrif_Set_type(vn,(/2,1,0/),(/3,2,0/))
120
121	Call Agrif_Set_type(ua,(/1,2,0/),(/2,3,0/))
122	Call Agrif_Set_type(va,(/2,1,0/),(/3,2,0/))
123
124	Call Agrif_Set_type(e1u,(/1,2/),(/2,3/))
125	Call Agrif_Set_type(e2v,(/2,1/),(/3,2/))
126
127	Call Agrif_Set_type(tn,(/2,2,0/),(/3,3,0/))
128	Call Agrif_Set_type(sn,(/2,2,0/),(/3,3,0/))
129
130	Call Agrif_Set_type(tb,(/2,2,0/),(/3,3,0/))
131	Call Agrif_Set_type(sb,(/2,2,0/),(/3,3,0/))
132
133	Call Agrif_Set_type(ta,(/2,2,0/),(/3,3,0/))
134	Call Agrif_Set_type(sa,(/2,2,0/),(/3,3,0/))
135
136	Call Agrif_Set_type(sshn,(/2,2/),(/3,3/))
137	Call Agrif_Set_type(gcb,(/2,2/),(/3,3/))
138
139	#if defined key_top
140	Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/))
141	Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/))
142	Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/))
143	#endif
144
145	! 2. Space directions for each variables
146	!---------------------------------------
147	Call Agrif_Set_raf(un,(/'x','y','N'/))
148	Call Agrif_Set_raf(vn,(/'x','y','N'/))
149
150	Call Agrif_Set_raf(ua,(/'x','y','N'/))
151	Call Agrif_Set_raf(va,(/'x','y','N'/))
152
153	Call Agrif_Set_raf(e1u,(/'x','y'/))
154	Call Agrif_Set_raf(e2v,(/'x','y'/))
155
156	Call Agrif_Set_raf(tn,(/'x','y','N'/))
157	Call Agrif_Set_raf(sn,(/'x','y','N'/))
158
159	Call Agrif_Set_raf(tb,(/'x','y','N'/))
160	Call Agrif_Set_raf(sb,(/'x','y','N'/))
161
162	Call Agrif_Set_raf(ta,(/'x','y','N'/))
163	Call Agrif_Set_raf(sa,(/'x','y','N'/))
164
165	Call Agrif_Set_raf(sshn,(/'x','y'/))
166	Call Agrif_Set_raf(gcb,(/'x','y'/))
167
168	#if defined key_top
169	Call Agrif_Set_raf(trn,(/'x','y','N','N'/))
170	Call Agrif_Set_raf(trb,(/'x','y','N','N'/))
171	Call Agrif_Set_raf(tra,(/'x','y','N','N'/))
172	#endif
173
174	! 3. Type of interpolation
175	!-------------------------
176	Call Agrif_Set_bcinterp(tn,interp=AGRIF_linear)
177	Call Agrif_Set_bcinterp(sn,interp=AGRIF_linear)
178
179	Call Agrif_Set_bcinterp(ta,interp=AGRIF_linear)
180	Call Agrif_Set_bcinterp(sa,interp=AGRIF_linear)
181
182	Call Agrif_Set_bcinterp(un,interp1=Agrif_linear,interp2=AGRIF_ppm)
183	Call Agrif_Set_bcinterp(vn,interp1=AGRIF_ppm,interp2=Agrif_linear)
184
185	Call Agrif_Set_bcinterp(ua,interp1=Agrif_linear,interp2=AGRIF_ppm)
186	Call Agrif_Set_bcinterp(va,interp1=AGRIF_ppm,interp2=Agrif_linear)
187
188	Call Agrif_Set_bcinterp(e1u,interp1=Agrif_linear,interp2=AGRIF_ppm)
189	Call Agrif_Set_bcinterp(e2v,interp1=AGRIF_ppm,interp2=Agrif_linear)
190
191	#if defined key_top
192	Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear)
193	Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear)
194	#endif
195
196	! 4. Location of interpolation
197	!-----------------------------
198	Call Agrif_Set_bc(un,(/0,1/))
199	Call Agrif_Set_bc(vn,(/0,1/))
200
201	Call Agrif_Set_bc(e1u,(/0,0/))
202	Call Agrif_Set_bc(e2v,(/0,0/))
203
204	Call Agrif_Set_bc(tn,(/0,1/))
205	Call Agrif_Set_bc(sn,(/0,1/))
206
207	Call Agrif_Set_bc(ta,(/-3*Agrif_irhox(),0/))
208	Call Agrif_Set_bc(sa,(/-3*Agrif_irhox(),0/))
209
210	Call Agrif_Set_bc(ua,(/-2*Agrif_irhox(),0/))
211	Call Agrif_Set_bc(va,(/-2*Agrif_irhox(),0/))
212
213	#if defined key_top
214	Call Agrif_Set_bc(trn,(/0,1/))
215	Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/))
216	#endif
217
218	! 5. Update type
219	!---------------
220	Call Agrif_Set_Updatetype(tn, update = AGRIF_Update_Average)
221	Call Agrif_Set_Updatetype(sn, update = AGRIF_Update_Average)
222
223	Call Agrif_Set_Updatetype(tb, update = AGRIF_Update_Average)
224	Call Agrif_Set_Updatetype(sb, update = AGRIF_Update_Average)
225
226	Call Agrif_Set_Updatetype(sshn, update = AGRIF_Update_Average)
227	Call Agrif_Set_Updatetype(gcb,update = AGRIF_Update_Average)
228
229	#if defined key_top
230	Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average)
231	Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average)
232	#endif
233
234	Call Agrif_Set_Updatetype(un,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
235	Call Agrif_Set_Updatetype(vn,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
236
237	Call Agrif_Set_Updatetype(e1u,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
238	Call Agrif_Set_Updatetype(e2v,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
239
240	! 6. First interpolations of potentially non zero fields
241	!-------------------------------------------------------
242	Agrif_SpecialValue=0.
243	Agrif_UseSpecialValue = .TRUE.
244	Call Agrif_Bc_variable(tabtemp,tn,calledweight=1.)
245	Call Agrif_Bc_variable(tabtemp,sn,calledweight=1.)
246	Call Agrif_Bc_variable(tabtemp,un,calledweight=1.,procname=interpu)
247	Call Agrif_Bc_variable(tabtemp,vn,calledweight=1.,procname=interpv)
248
249	Call Agrif_Bc_variable(tabtemp,ta,calledweight=1.,procname=interptn)
250	Call Agrif_Bc_variable(tabtemp,sa,calledweight=1.,procname=interpsn)
251
252	Call Agrif_Bc_variable(tabtemp,ua,calledweight=1.,procname=interpun)
253	Call Agrif_Bc_variable(tabtemp,va,calledweight=1.,procname=interpvn)
254
255	#if defined key_top
256	Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.)
257	Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn)
258	#endif
259	Agrif_UseSpecialValue = .FALSE.
260
261	! 7. Some controls
262	!-----------------
263	check_namelist = .true.
264
265	IF( check_namelist ) THEN
266
267	! Check time steps
268	IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
269	WRITE(,) 'incompatible time step between grids'
270	WRITE(,) 'parent grid value : ',Agrif_Parent(rdt)
271	WRITE(,) 'child grid value : ',nint(rdt)
272	WRITE(,) 'value on parent grid should be : ',rdt*Agrif_Rhot()
273	STOP
274	ENDIF
275
276	! Check run length
277	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
278	Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
279	WRITE(,) 'incompatible run length between grids'
280	WRITE(,) 'parent grid value : ',(Agrif_Parent(nitend)- &
281	Agrif_Parent(nit000)+1),' time step'
282	WRITE(,) 'child grid value : ', &
283	(nitend-nit000+1),' time step'
284	WRITE(,) 'value on child grid should be : ', &
285	Agrif_IRhot() * (Agrif_Parent(nitend)- &
286	Agrif_Parent(nit000)+1)
287	STOP
288	ENDIF
289
290	! Check coordinates
291	IF( ln_zps ) THEN
292	! check parameters for partial steps
293	IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
294	WRITE(,) 'incompatible e3zps_min between grids'
295	WRITE(,) 'parent grid :',Agrif_Parent(e3zps_min)
296	WRITE(,) 'child grid :',e3zps_min
297	WRITE(,) 'those values should be identical'
298	STOP
299	ENDIF
300	IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
301	WRITE(,) 'incompatible e3zps_rat between grids'
302	WRITE(,) 'parent grid :',Agrif_Parent(e3zps_rat)
303	WRITE(,) 'child grid :',e3zps_rat
304	WRITE(,) 'those values should be identical'
305	STOP
306	ENDIF
307	ENDIF
308	#if defined key_top
309	! Check passive tracer cell
310	IF( nn_dttrc .ne. 1 ) THEN
311	WRITE(,) 'nn_dttrc should be equal to 1'
312	ENDIF
313	#endif
314
315	ENDIF
316
317	#if defined key_top
318	CALL Agrif_Update_trc(0)
319	#endif
320	CALL Agrif_Update_tra(0)
321	CALL Agrif_Update_dyn(0)
322
323	#if defined key_top
324	nbcline_trc = 0
325	#endif
326	nbcline = 0
327	!
328	END SUBROUTINE Agrif_InitValues
329
330	#else
331
332	SUBROUTINE Agrif_InitValues
333	!!----------------------------------------------------------------------
334	!! * ROUTINE Agrif_InitValues *
335	!!
336	!! ** Purpose :: Declaration of variables to be interpolated
337	!!----------------------------------------------------------------------
338	USE Agrif_Util
339	USE oce
340	USE dom_oce
341	USE opa
342	USE trc
343	USE in_out_manager
344	USE agrif_top_update
345	USE agrif_top_interp
346	USE agrif_top_sponge
347	!!
348	IMPLICIT NONE
349	!!
350	REAL(wp) :: tabtrtemp(jpi,jpj,jpk,jptra)
351	LOGICAL check_namelist
352	!!----------------------------------------------------------------------
353
354	! 0. Initializations
355	!-------------------
356	#if defined key_orca_r025 \|\| defined key_orca_r05 \|\| defined key_orca_r2 \|\| defined key_orca_r4
357	jp_cfg = -1 ! set special value for jp_cfg on fine grids
358	cp_cfg = "default"
359	#endif
360
361	Call opa_init ! Initializations of each fine grid
362	Call agrif_opa_init
363
364	! 1. Declaration of the type of variable which have to be interpolated
365	!---------------------------------------------------------------------
366	Call Agrif_Set_type(trb,(/2,2,0,0/),(/3,3,0,0/))
367	Call Agrif_Set_type(trn,(/2,2,0,0/),(/3,3,0,0/))
368	Call Agrif_Set_type(tra,(/2,2,0,0/),(/3,3,0,0/))
369
370	! 2. Space directions for each variables
371	!---------------------------------------
372	Call Agrif_Set_raf(trn,(/'x','y','N','N'/))
373	Call Agrif_Set_raf(trb,(/'x','y','N','N'/))
374	Call Agrif_Set_raf(tra,(/'x','y','N','N'/))
375
376	! 3. Type of interpolation
377	!-------------------------
378	Call Agrif_Set_bcinterp(trn,interp=AGRIF_linear)
379	Call Agrif_Set_bcinterp(tra,interp=AGRIF_linear)
380
381	! 4. Location of interpolation
382	!-----------------------------
383	Call Agrif_Set_bc(trn,(/0,1/))
384	Call Agrif_Set_bc(tra,(/-3*Agrif_irhox(),0/))
385
386	! 5. Update type
387	!---------------
388	Call Agrif_Set_Updatetype(trn, update = AGRIF_Update_Average)
389	Call Agrif_Set_Updatetype(trb, update = AGRIF_Update_Average)
390
391	! 6. First interpolations of potentially non zero fields
392	!-------------------------------------------------------
393	Agrif_SpecialValue=0.
394	Agrif_UseSpecialValue = .TRUE.
395	Call Agrif_Bc_variable(tabtrtemp,trn,calledweight=1.)
396	Call Agrif_Bc_variable(tabtrtemp,tra,calledweight=1.,procname=interptrn)
397	Agrif_UseSpecialValue = .FALSE.
398
399	! 7. Some controls
400	!-----------------
401	check_namelist = .true.
402
403	IF( check_namelist ) THEN
404
405	! Check time steps
406	IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
407	WRITE(,) 'incompatible time step between grids'
408	WRITE(,) 'parent grid value : ',Agrif_Parent(rdt)
409	WRITE(,) 'child grid value : ',nint(rdt)
410	WRITE(,) 'value on parent grid should be : ',rdt*Agrif_Rhot()
411	STOP
412	ENDIF
413
414	! Check run length
415	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
416	Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
417	WRITE(,) 'incompatible run length between grids'
418	WRITE(,) 'parent grid value : ',(Agrif_Parent(nitend)- &
419	Agrif_Parent(nit000)+1),' time step'
420	WRITE(,) 'child grid value : ', &
421	(nitend-nit000+1),' time step'
422	WRITE(,) 'value on child grid should be : ', &
423	Agrif_IRhot() * (Agrif_Parent(nitend)- &
424	Agrif_Parent(nit000)+1)
425	STOP
426	ENDIF
427
428	! Check coordinates
429	IF( ln_zps ) THEN
430	! check parameters for partial steps
431	IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN
432	WRITE(,) 'incompatible e3zps_min between grids'
433	WRITE(,) 'parent grid :',Agrif_Parent(e3zps_min)
434	WRITE(,) 'child grid :',e3zps_min
435	WRITE(,) 'those values should be identical'
436	STOP
437	ENDIF
438	IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN
439	WRITE(,) 'incompatible e3zps_rat between grids'
440	WRITE(,) 'parent grid :',Agrif_Parent(e3zps_rat)
441	WRITE(,) 'child grid :',e3zps_rat
442	WRITE(,) 'those values should be identical'
443	STOP
444	ENDIF
445	ENDIF
446	! Check passive tracer cell
447	IF( nn_dttrc .ne. 1 ) THEN
448	WRITE(,) 'nn_dttrc should be equal to 1'
449	ENDIF
450
451	ENDIF
452
453	CALL Agrif_Update_trc(0)
454	nbcline_trc = 0
455	!
456	END SUBROUTINE Agrif_InitValues
457
458	#endif
459
460	SUBROUTINE Agrif_detect( g, sizex )
461	!!----------------------------------------------------------------------
462	!! * ROUTINE Agrif_detect *
463	!!----------------------------------------------------------------------
464	USE Agrif_Types
465	!!
466	INTEGER, DIMENSION(2) :: sizex
467	INTEGER, DIMENSION(sizex(1),sizex(2)) :: g
468	!!----------------------------------------------------------------------
469	!
470	RETURN
471	!
472	END SUBROUTINE Agrif_detect
473
474
475	SUBROUTINE agrif_opa_init
476	!!----------------------------------------------------------------------
477	!! * ROUTINE agrif_init *
478	!!----------------------------------------------------------------------
479	USE agrif_oce
480	USE in_out_manager
481	!!
482	IMPLICIT NONE
483	!!
484	NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
485	!!----------------------------------------------------------------------
486
487	REWIND( numnam ) ! Read namagrif namelist
488	READ ( numnam, namagrif )
489	!
490	IF(lwp) THEN ! control print
491	WRITE(numout,*)
492	WRITE(numout,*) 'agrif_opa_init : AGRIF parameters'
493	WRITE(numout,*) '~~~~~~~~~~~~'
494	WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters'
495	WRITE(numout,*) ' baroclinic update frequency nn_cln_update = ', nn_cln_update
496	WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' s'
497	WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' s'
498	WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn
499	WRITE(numout,*)
500	ENDIF
501	!
502	! convert DOCTOR namelist name into OLD names
503	nbclineupdate = nn_cln_update
504	visc_tra = rn_sponge_tra
505	visc_dyn = rn_sponge_dyn
506	!
507	END SUBROUTINE agrif_opa_init
508
509	# if defined key_mpp_mpi
510
511	SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
512	!!----------------------------------------------------------------------
513	!! * ROUTINE Agrif_detect *
514	!!----------------------------------------------------------------------
515	USE dom_oce
516	!!
517	IMPLICIT NONE
518	!!
519	INTEGER :: indglob,indloc,nprocloc,i
520	!!----------------------------------------------------------------------
521	!
522	SELECT CASE(i)
523	CASE(1)
524	indglob = indloc + nimppt(nprocloc+1) - 1
525	CASE(2)
526	indglob = indloc + njmppt(nprocloc+1) - 1
527	CASE(3)
528	indglob = indloc
529	CASE(4)
530	indglob = indloc
531	END SELECT
532	!
533	END SUBROUTINE Agrif_InvLoc
534
535	# endif
536
537	#else
538	SUBROUTINE Subcalledbyagrif
539	!!----------------------------------------------------------------------
540	!! * ROUTINE Subcalledbyagrif *
541	!!----------------------------------------------------------------------
542	WRITE(,) 'Impossible to be here'
543	END SUBROUTINE Subcalledbyagrif
544	#endif

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

Download in other formats: