Context Navigation

create_coord.f90 @ 13369

Last change on this file since 13369 was 13369, checked in by jpaul, 4 years ago
update: cf changelog inside documentation
File size: 28.3 KB

Line
1	!----------------------------------------------------------------------
2	! NEMO system team, System and Interface for oceanic RElocable Nesting
3	!----------------------------------------------------------------------
4	!
5	! DESCRIPTION:
6	!> @file
7	!> @brief
8	!> this program creates target/fine grid coordinate file.
9	!>
10	!> @details
11	!> @section sec1 method
12	!> variables from the input coordinates coarse/source grid file, are extracted
13	!> and interpolated to create a fine/taget grid coordinates file.<br/>
14	!> @note
15	!> interpolation method could be different for each variable.
16	!>
17	!> \image html header_coord_40.png
18	!> <center> \image latex header_coord_40.png
19	!> </center>
20	!>
21	!> @section sec2 how to
22	!> USAGE: create_coord create_coord.nam [-v] [-h]<br/>
23	!> - positional arguments:<br/>
24	!> - create_coord.nam<br/>
25	!> namelist of create_coord
26	!> @note
27	!> a template of the namelist could be created running (in templates directory):
28	!> @code{.sh}
29	!> python create_templates.py create_coord
30	!> @endcode
31	!>
32	!> - optional arguments:<br/>
33	!> - -h, --help<br/>
34	!> show this help message (and exit)<br/>
35	!> - -v, --version<br/>
36	!> show Siren's version (and exit)
37	!>
38	!> @section sec_coord create_coord.nam
39	!> create_coord.nam contains 6 sub-namelists:<br/>
40	!> - namlog to set logger parameters
41	!> - namcfg to set configuration file parameters
42	!> - namsrc to set source/coarse grid parameters
43	!> - namvar to set variable parameters
44	!> - namnst to set sub domain and nesting paramters
45	!> - namout to set output parameters
46	!>
47	!> here after, each sub-namelist parameters is detailed.
48	!> @note
49	!> default values are specified between brackets
50	!>
51	!> @subsection sublog namlog
52	!> the logger sub-namelist parameters are :
53	!>
54	!> - cn_logfile [@a create_coord.log]<br/>
55	!> logger filename
56	!>
57	!> - cn_verbosity [@a warning]<br/>
58	!> verbosity level, choose between :
59	!> - trace
60	!> - debug
61	!> - info
62	!> - warning
63	!> - error
64	!> - fatal
65	!> - none
66	!>
67	!> - in_maxerror [@a 5]<br/>
68	!> maximum number of error allowed
69	!>
70	!> @subsection subcfg namcfg
71	!> the configuration sub-namelist parameters are :
72	!>
73	!> - cn_varcfg [@a ./cfg/variable.cfg]<br/>
74	!> path to the variable configuration file.<br/>
75	!> the variable configuration file defines standard name,
76	!> default interpolation method, axis,...
77	!> to be used for some known variables.<br/>
78	!>
79	!> - cn_dimcfg [@a ./cfg/dimension.cfg]<br/>
80	!> path to the dimension configuration file.<br/>
81	!> the dimension configuration file defines dimensions allowed.<br/>
82	!>
83	!> - cn_dumcfg [@a ./cfg/dummy.cfg]<br/>
84	!> path to the useless (dummy) configuration file.<br/>
85	!> the dummy configuration file defines useless
86	!> dimension or variable. these dimension(s) or variable(s) will not be
87	!> processed.<br/>
88	!>
89	!> @subsection subsrc namsrc
90	!> the source/coarse grid sub-namelist parameters are :
91	!>
92	!> - cn_coord0 [@a ]<br/>
93	!> path to the coordinate file
94	!>
95	!> - in_perio0 [@a ]<br/>
96	!> NEMO periodicity index<br/>
97	!> the NEMO periodicity could be choose between 0 to 6:
98	!> <dl>
99	!> <dt>in_perio=0</dt>
100	!> <dd>standard regional model</dd>
101	!> <dt>in_perio=1</dt>
102	!> <dd>east-west cyclic model</dd>
103	!> <dt>in_perio=2</dt>
104	!> <dd>model with symmetric boundary condition across the equator</dd>
105	!> <dt>in_perio=3</dt>
106	!> <dd>regional model with North fold boundary and T-point pivot</dd>
107	!> <dt>in_perio=4</dt>
108	!> <dd>global model with a T-point pivot.<br/>
109	!> example: ORCA2, ORCA025, ORCA12</dd>
110	!> <dt>in_perio=5</dt>
111	!> <dd>regional model with North fold boundary and F-point pivot</dd>
112	!> <dt>in_perio=6</dt>
113	!> <dd>global model with a F-point pivot<br/>
114	!> example: ORCA05</dd>
115	!> </dd>
116	!> </dl>
117	!> @sa For more information see @ref md_src_docsrc_6_perio
118	!> and Model Boundary Condition paragraph in the
119	!> [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf)
120	!>
121	!> @subsection subvar namvar
122	!> the variable sub-namelist parameters are :
123	!>
124	!> - cn_varinfo [@a ]<br/>
125	!> list of variable and extra information about request(s) to be used<br/>
126	!>
127	!> each elements of cn_varinfo is a string character (separated by ',').<br/>
128	!> it is composed of the variable name follow by ':',
129	!> then request(s) to be used on this variable.<br/>
130	!> request could be:
131	!> - int = interpolation method
132	!> - ext = extrapolation method
133	!>
134	!> requests must be separated by ';'.<br/>
135	!> order of requests does not matter.<br/>
136	!>
137	!> informations about available method could be find in @ref interp,
138	!> @ref extrap and @ref filter modules.<br/>
139	!> Example:
140	!> - 'glamt: int=linear; ext=dist_weight', 'e1t: int=cubic/rhoi'
141	!>
142	!> @note
143	!> If you do not specify a method which is required,
144	!> default one is apply.
145	!>
146	!> @subsection subnst namnst
147	!> the nesting sub-namelist parameters are :
148	!>
149	!> - in_imin0 [@a ]<br/>
150	!> i-direction lower left point indice of source/coarse grid subdomain to be used
151	!> - in_imax0 [@a ]<br/>
152	!> i-direction upper right point indice of source/coarse grid subdomain to be used
153	!> - in_jmin0 [@a ]<br/>
154	!> j-direction lower left point indice of source/coarse grid subdomain to be used
155	!> - in_jmax0 [@a ]<br/>
156	!> j-direction upper right point indice of source/coarse grid subdomain to be used
157	!> <br/>or<br/>
158	!> - rn_lonmin0 [@a ]<br/>
159	!> lower left longitude of source/coarse grid subdomain to be used
160	!> - rn_lonmax0 [@a ]<br/>
161	!> upper right longitude of source/coarse grid subdomain to be used
162	!> - rn_latmin0 [@a ]<br/>
163	!> lower left latitude of source/coarse grid subdomain to be used
164	!> - rn_latmax0 [@a ]<br/>
165	!> upper right latitude of source/coarse grid subdomain to be used
166	!> @note you could define sub domain with
167	!> - coarse/source grid indices
168	!> <br/>or<br/>
169	!> - coordinates.<br/>
170	!> if coordinates are defined (-180 < lon < 360 and -90 < lat < 90),
171	!> SIREN does not take into account indices.
172	!>
173	!> - in_rhoi [@a 1]<br/>
174	!> refinement factor in i-direction
175	!>
176	!> - in_rhoj [@a 1]<br/>
177	!> refinement factor in j-direction
178	!>
179	!> \image html grid_zoom_60.png
180	!> <center> \image latex grid_zoom_40.png
181	!> </center>
182	!>
183	!> @subsection subout namout
184	!> the output sub-namelist parameter is :
185	!>
186	!> - cn_fileout [@a coord_fine.nc]<br/>
187	!> output bathymetry filename
188	!>
189	!> <hr>
190	!> @author J.Paul
191	!>
192	!> @date November, 2013 - Initial Version
193	!> @date September, 2014
194	!> - add header for user
195	!> - compute offset considering grid point
196	!> - add global attributes in output file
197	!> @date September, 2015
198	!> - manage useless (dummy) variable, attributes, and dimension
199	!> @date September, 2016
200	!> - allow to use coordinate to define subdomain
201	!> @date October, 2016
202	!> - dimension to be used select from configuration file
203	!> @date January, 2019
204	!> - add url path to global attributes of output file(s)
205	!> @date February, 2019
206	!> - rename sub namelist namcrs to namsrc
207	!> - create and clean file structure to avoid memory leaks
208	!> @date Ocober, 2019
209	!> - add help and version optional arguments
210	!>
211	!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
212	!----------------------------------------------------------------------
213	PROGRAM create_coord
214
215	USE global ! global variable
216	USE kind ! F90 kind parameter
217	USE logger ! log file manager
218	USE fct ! basic useful function
219	USE date ! date manager
220	USE att ! attribute manager
221	USE dim ! dimension manager
222	USE var ! variable manager
223	USE file ! file manager
224	USE iom ! I/O manager
225	USE grid ! grid manager
226	USE extrap ! extrapolation manager
227	USE interp ! interpolation manager
228	USE filter ! filter manager
229	USE mpp ! MPP manager
230	USE dom ! domain manager
231	USE iom_mpp ! MPP I/O manager
232	USE iom_dom ! DOM I/O manager
233
234	IMPLICIT NONE
235
236	! parameters
237	CHARACTER(LEN=lc), PARAMETER :: cp_myname = "create_coord"
238
239	! local variable
240	CHARACTER(LEN=lc) :: cl_arg
241	CHARACTER(LEN=lc) :: cl_namelist
242	CHARACTER(LEN=lc) :: cl_date
243	CHARACTER(LEN=lc) :: cl_url
244	CHARACTER(LEN=lc) :: cl_errormsg
245
246	INTEGER(i4) :: il_narg
247	INTEGER(i4) :: il_status
248	INTEGER(i4) :: il_fileid
249	INTEGER(i4) :: il_attid
250	INTEGER(i4) :: il_ind
251	INTEGER(i4) :: il_nvar
252	INTEGER(i4) :: il_ew
253	INTEGER(i4) :: il_imin0
254	INTEGER(i4) :: il_imax0
255	INTEGER(i4) :: il_jmin0
256	INTEGER(i4) :: il_jmax0
257
258	INTEGER(i4) , DIMENSION(ip_maxdim) :: il_rho
259	INTEGER(i4) , DIMENSION(2) :: il_index
260	INTEGER(i4) , DIMENSION(2,2,ip_npoint) :: il_offset
261
262	LOGICAL :: ll_exist
263
264	TYPE(TATT) :: tl_att
265
266	TYPE(TDOM) :: tl_dom
267
268	TYPE(TVAR) , DIMENSION(:) , ALLOCATABLE :: tl_var
269
270	TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
271
272	TYPE(TFILE) :: tl_file
273
274	TYPE(TMPP) :: tl_coord0
275	TYPE(TFILE) :: tl_fileout
276
277	! loop indices
278	INTEGER(i4) :: ji
279	INTEGER(i4) :: jj
280
281	! namelist variable
282	! namlog
283	CHARACTER(LEN=lc) :: cn_logfile = 'create_coord.log'
284	CHARACTER(LEN=lc) :: cn_verbosity= 'warning'
285	INTEGER(i4) :: in_maxerror = 5
286
287	! namcfg
288	CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg'
289	CHARACTER(LEN=lc) :: cn_dimcfg = './cfg/dimension.cfg'
290	CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg'
291
292	! namsrc
293	CHARACTER(LEN=lc) :: cn_coord0 = ''
294	INTEGER(i4) :: in_perio0 = -1
295
296	! namvar
297	CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
298
299	!namnst
300	REAL(sp) :: rn_lonmin0 = -360.
301	REAL(sp) :: rn_lonmax0 = -360.
302	REAL(sp) :: rn_latmin0 = -360.
303	REAL(sp) :: rn_latmax0 = -360.
304	INTEGER(i4) :: in_imin0 = 0
305	INTEGER(i4) :: in_imax0 = 0
306	INTEGER(i4) :: in_jmin0 = 0
307	INTEGER(i4) :: in_jmax0 = 0
308	INTEGER(i4) :: in_rhoi = 1
309	INTEGER(i4) :: in_rhoj = 1
310
311	!namout
312	CHARACTER(LEN=lc) :: cn_fileout = 'coord_fine.nc'
313	!-------------------------------------------------------------------
314
315	NAMELIST /namlog/ & ! logger namelist
316	& cn_logfile, & !< logger file name
317	& cn_verbosity, & !< logger verbosity
318	& in_maxerror !< logger maximum error
319
320	NAMELIST /namcfg/ & !< configuration namelist
321	& cn_varcfg, & !< variable configuration file
322	& cn_dimcfg, & !< dimension configuration file
323	& cn_dumcfg !< dummy configuration file
324
325	NAMELIST /namsrc/ & !< source/coarse grid namelist
326	& cn_coord0 , & !< coordinate file
327	& in_perio0 !< periodicity index
328
329	NAMELIST /namvar/ & !< variable namelist
330	& cn_varinfo !< list of variable and extra information about
331	!< interpolation, extrapolation or filter method to be used.
332	!< (ex: 'votemper:linear,hann,dist_weight','vosaline:cubic' )
333
334	NAMELIST /namnst/ & !< nesting namelist
335	& rn_lonmin0, & !< lower left source/coarse grid longitude
336	& rn_lonmax0, & !< upper right source/coarse grid longitude
337	& rn_latmin0, & !< lower left source/coarse grid latitude
338	& rn_latmax0, & !< upper right source/coarse grid latitude
339	& in_imin0, & !< i-direction lower left point indice
340	& in_imax0, & !< i-direction upper right point indice
341	& in_jmin0, & !< j-direction lower left point indice
342	& in_jmax0, & !< j-direction upper right point indice
343	& in_rhoi, & !< refinement factor in i-direction
344	& in_rhoj !< refinement factor in j-direction
345
346	NAMELIST /namout/ & !< output namelist
347	& cn_fileout !< target/fine grid coordinate file
348	!-------------------------------------------------------------------
349
350	!
351	! Initialisation
352	! --------------
353	!
354	il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
355
356	! Traitement des arguments fournis
357	! --------------------------------
358	IF( il_narg /= 1 )THEN
359	WRITE(cl_errormsg,*) ' ERROR : one argument is needed '
360	CALL fct_help(cp_myname,cl_errormsg)
361	CALL EXIT(1)
362	ELSE
363
364	CALL GET_COMMAND_ARGUMENT(1,cl_arg) !f03 intrinsec
365	SELECT CASE (cl_arg)
366	CASE ('-v', '--version')
367
368	CALL fct_version(cp_myname)
369	CALL EXIT(0)
370
371	CASE ('-h', '--help')
372
373	CALL fct_help(cp_myname)
374	CALL EXIT(0)
375
376	CASE DEFAULT
377
378	cl_namelist=cl_arg
379
380	! read namelist
381	INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
382	IF( ll_exist )THEN
383
384	il_fileid=fct_getunit()
385
386	OPEN( il_fileid, FILE=TRIM(cl_namelist), &
387	& FORM='FORMATTED', &
388	& ACCESS='SEQUENTIAL', &
389	& STATUS='OLD', &
390	& ACTION='READ', &
391	& IOSTAT=il_status)
392	CALL fct_err(il_status)
393	IF( il_status /= 0 )THEN
394	WRITE(cl_errormsg,*) " ERROR : error opening "//TRIM(cl_namelist)
395	CALL fct_help(cp_myname,cl_errormsg)
396	CALL EXIT(1)
397	ENDIF
398
399	READ( il_fileid, NML = namlog )
400
401	! define logger file
402	CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
403	CALL logger_header()
404
405	READ( il_fileid, NML = namcfg )
406	! get variable extra information on configuration file
407	CALL var_def_extra(TRIM(cn_varcfg))
408
409	! get dimension allowed
410	CALL dim_def_extra(TRIM(cn_dimcfg))
411
412	! get dummy variable
413	CALL var_get_dummy(TRIM(cn_dumcfg))
414	! get dummy dimension
415	CALL dim_get_dummy(TRIM(cn_dumcfg))
416	! get dummy attribute
417	CALL att_get_dummy(TRIM(cn_dumcfg))
418
419	READ( il_fileid, NML = namsrc )
420	READ( il_fileid, NML = namvar )
421	! add user change in extra information
422	CALL var_chg_extra( cn_varinfo )
423
424	READ( il_fileid, NML = namnst )
425	READ( il_fileid, NML = namout )
426
427	CLOSE( il_fileid, IOSTAT=il_status )
428	CALL fct_err(il_status)
429	IF( il_status /= 0 )THEN
430	CALL logger_error("CREATE COORD: closing "//TRIM(cl_namelist))
431	ENDIF
432
433	ELSE
434
435	WRITE(cl_errormsg,*) " ERROR : can't find "//TRIM(cl_namelist)
436	CALL fct_help(cp_myname,cl_errormsg)
437	CALL EXIT(1)
438
439	ENDIF
440
441	END SELECT
442	ENDIF
443
444	! open files
445	IF( cn_coord0 /= '' )THEN
446	tl_file=file_init(TRIM(cn_coord0))
447	tl_coord0=mpp_init( tl_file, id_perio=in_perio0)
448	! clean
449	CALL file_clean(tl_file)
450	CALL grid_get_info(tl_coord0)
451	ELSE
452	CALL logger_fatal("CREATE COORD: no source/coarse grid coordinate found. "//&
453	& "check namelist")
454	ENDIF
455
456	! check
457	! check output file do not already exist
458	INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist)
459	IF( ll_exist )THEN
460	CALL logger_fatal("CREATE COORD: output file "//TRIM(cn_fileout)//&
461	& " already exist.")
462	ENDIF
463
464	! check nesting parameters
465	il_index(:)=0
466	IF( rn_lonmin0 >= -180. .AND. rn_lonmin0 <= 360 .AND. &
467	& rn_latmin0 >= -90. .AND. rn_latmin0 <= 90. )THEN
468
469	il_index(:)=grid_get_closest(tl_coord0, &
470	& REAL(rn_lonmin0,dp), REAL(rn_latmin0,dp), &
471	& cd_pos='ll')
472	il_imin0=il_index(1)
473	il_jmin0=il_index(2)
474	ELSE
475	il_imin0=in_imin0
476	il_jmin0=in_jmin0
477	ENDIF
478
479	il_index(:)=0
480	IF( rn_lonmax0 >= -180. .AND. rn_lonmax0 <= 360 .AND. &
481	& rn_latmax0 >= -90. .AND. rn_latmax0 <= 90. )THEN
482
483	il_index(:)=grid_get_closest(tl_coord0, &
484	& REAL(rn_lonmax0,dp), REAL(rn_latmax0,dp), &
485	& cd_pos='ur')
486	il_imax0=il_index(1)
487	il_jmax0=il_index(2)
488	ELSE
489	il_imax0=in_imax0
490	il_jmax0=in_jmax0
491	ENDIF
492
493	! forced indices for east west cyclic domain
494	IF( rn_lonmin0 == rn_lonmax0 .AND. &
495	& rn_lonmin0 /= -360. )THEN
496	il_imin0=0
497	il_imax0=0
498	ENDIF
499
500	IF( il_imin0 < 0 .OR. il_imax0 < 0 .OR. il_jmin0 < 0 .OR. il_jmax0 < 0)THEN
501	CALL logger_fatal("CREATE COORD: invalid points indices."//&
502	& " check namelist "//TRIM(cl_namelist))
503	ENDIF
504
505	il_rho(:)=1
506	IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
507	CALL logger_error("CREATE COORD: invalid refinement factor."//&
508	& " check namelist "//TRIM(cl_namelist))
509	ELSE
510	il_rho(jp_I)=in_rhoi
511	il_rho(jp_J)=in_rhoj
512
513	il_offset(:,:,:)=create_coord_get_offset(il_rho(:))
514	ENDIF
515
516	! check domain validity
517	CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0 )
518
519	! compute domain
520	tl_dom=dom_init( tl_coord0, &
521	& il_imin0, il_imax0,&
522	& il_jmin0, il_jmax0 )
523
524	! add extra band (if need be) to compute interpolation
525	CALL dom_add_extra(tl_dom)
526
527	! open mpp files
528	CALL iom_dom_open(tl_coord0, tl_dom)
529
530	il_nvar=tl_coord0%t_proc(1)%i_nvar
531	ALLOCATE( tl_var(il_nvar) )
532	DO ji=1,il_nvar
533
534	tl_var(ji)=iom_dom_read_var(tl_coord0, &
535	& TRIM(tl_coord0%t_proc(1)%t_var(ji)%c_name),&
536	& tl_dom)
537
538	SELECT CASE(TRIM(tl_var(ji)%c_point))
539	CASE('T')
540	jj=jp_T
541	CASE('U')
542	jj=jp_U
543	CASE('V')
544	jj=jp_V
545	CASE('F')
546	jj=jp_F
547	END SELECT
548
549	! interpolate variables
550	CALL create_coord_interp( tl_var(ji), il_rho(:), &
551	& il_offset(:,:,jj) )
552
553	! remove extraband added to domain
554	CALL dom_del_extra( tl_var(ji), tl_dom, il_rho(:), .true. )
555
556	! filter
557	CALL filter_fill_value(tl_var(ji))
558
559	ENDDO
560
561	! clean
562	CALL dom_clean_extra( tl_dom )
563
564	! close mpp files
565	CALL iom_dom_close(tl_coord0)
566
567	! clean
568	CALL mpp_clean(tl_coord0)
569
570	! create file
571	tl_fileout=file_init(TRIM(cn_fileout))
572
573	! add dimension
574	! save biggest dimension
575	tl_dim(:)=var_max_dim(tl_var(:))
576
577	DO ji=1,ip_maxdim
578	IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
579	ENDDO
580
581	! add variables
582	DO ji=il_nvar,1,-1
583	CALL file_add_var(tl_fileout, tl_var(ji))
584	CALL var_clean(tl_var(ji))
585	ENDDO
586
587	! add some attribute
588	tl_att=att_init("Created_by","SIREN create_coord")
589	CALL file_add_att(tl_fileout, tl_att)
590
591	!add source url
592	cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:')
593	tl_att=att_init("SIREN_url",cl_url)
594	CALL file_add_att(tl_fileout, tl_att)
595
596	! add date of creation
597	cl_date=date_print(date_now())
598	tl_att=att_init("Creation_date",cl_date)
599	CALL file_add_att(tl_fileout, tl_att)
600
601	tl_att=att_init("src_file",TRIM(fct_basename(cn_coord0)))
602	CALL file_add_att(tl_fileout, tl_att)
603
604	tl_att=att_init("src_i_indices",(/tl_dom%i_imin,tl_dom%i_imax/))
605	CALL file_add_att(tl_fileout, tl_att)
606	tl_att=att_init("src_j_indices",(/tl_dom%i_jmin,tl_dom%i_jmax/))
607	CALL file_add_att(tl_fileout, tl_att)
608	IF( .NOT. ALL(il_rho(:)==1) )THEN
609	tl_att=att_init("refinment_factor",(/il_rho(jp_I),il_rho(jp_J)/))
610	CALL file_add_att(tl_fileout, tl_att)
611	ENDIF
612
613	! add attribute periodicity
614	il_attid=0
615	IF( ASSOCIATED(tl_fileout%t_att) )THEN
616	il_attid=att_get_index(tl_fileout%t_att(:),'periodicity')
617	ENDIF
618	IF( tl_dom%i_perio >= 0 .AND. il_attid == 0 )THEN
619	tl_att=att_init('periodicity',tl_dom%i_perio)
620	CALL file_add_att(tl_fileout,tl_att)
621	ENDIF
622
623	! add attribute east west overlap
624	il_attid=0
625	IF( ASSOCIATED(tl_fileout%t_att) )THEN
626	il_attid=att_get_index(tl_fileout%t_att(:),'ew_overlap')
627	ENDIF
628	IF( il_attid == 0 )THEN
629	il_ind=var_get_index(tl_fileout%t_var(:),'longitude')
630	IF( il_ind == 0 )THEN
631	il_ind=var_get_index(tl_fileout%t_var(:),'longitude_T')
632	ENDIF
633	il_ew=grid_get_ew_overlap(tl_fileout%t_var(il_ind))
634	IF( il_ew >= 0 )THEN
635	tl_att=att_init('ew_overlap',il_ew)
636	CALL file_add_att(tl_fileout,tl_att)
637	ENDIF
638	ENDIF
639
640	! create file
641	CALL iom_create(tl_fileout)
642
643	! write file
644	CALL iom_write_file(tl_fileout)
645
646	! close file
647	CALL iom_close(tl_fileout)
648
649	! clean
650	CALL att_clean(tl_att)
651	CALL var_clean(tl_var(:))
652	DEALLOCATE( tl_var)
653
654	CALL file_clean(tl_fileout)
655	CALL var_clean_extra()
656
657	! close log file
658	CALL logger_footer()
659	CALL logger_close()
660
661	CONTAINS
662	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
663	FUNCTION create_coord_get_offset(id_rho) &
664	& RESULT (if_offset)
665	!-------------------------------------------------------------------
666	!> @brief
667	!> This function compute offset over Arakawa grid points,
668	!> given refinement factor.
669	!>
670	!> @author J.Paul
671	!> @date August, 2014 - Initial Version
672	!>
673	!> @param[in] id_rho array of refinement factor
674	!> @return array of offset
675	!-------------------------------------------------------------------
676
677	IMPLICIT NONE
678
679	! Argument
680	INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_rho
681
682	! function
683	INTEGER(i4), DIMENSION(2,2,ip_npoint) :: if_offset
684
685	! local variable
686	! loop indices
687	!----------------------------------------------------------------
688
689	! case 'T'
690	if_offset(jp_I,:,jp_T)=FLOOR(REAL(id_rho(jp_I)-1,dp)*0.5)
691	if_offset(jp_J,:,jp_T)=FLOOR(REAL(id_rho(jp_J)-1,dp)*0.5)
692	! case 'U'
693	if_offset(jp_I,1,jp_U)=0
694	if_offset(jp_I,2,jp_U)=id_rho(jp_I)-1
695	if_offset(jp_J,:,jp_U)=FLOOR(REAL(id_rho(jp_J)-1,dp)*0.5)
696	! case 'V'
697	if_offset(jp_I,:,jp_V)=FLOOR(REAL(id_rho(jp_I)-1,dp)*0.5)
698	if_offset(jp_J,1,jp_V)=0
699	if_offset(jp_J,2,jp_V)=id_rho(jp_J)-1
700	! case 'F'
701	if_offset(jp_I,1,jp_F)=0
702	if_offset(jp_I,2,jp_F)=id_rho(jp_I)-1
703	if_offset(jp_J,1,jp_F)=0
704	if_offset(jp_J,2,jp_F)=id_rho(jp_J)-1
705
706	END FUNCTION create_coord_get_offset
707	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
708	SUBROUTINE create_coord_interp(td_var, id_rho, id_offset, &
709	& id_iext, id_jext)
710	!-------------------------------------------------------------------
711	!> @brief
712	!> This subroutine interpolate variable, given refinment factor.
713	!>
714	!> @details
715	!> Optionaly, you could specify number of points
716	!> to be extrapolated in i- and j-direction.<br/>
717	!> variable mask is first computed (using _FillValue) and interpolated.<br/>
718	!> variable is then extrapolated, and interpolated.<br/>
719	!> Finally interpolated mask is applied on refined variable.
720	!>
721	!> @author J.Paul
722	!> @date November, 2013 - Initial Version
723	!>
724	!> @param[inout] td_var variable strcuture
725	!> @param[in] id_rho array of refinement factor
726	!> @param[in] id_offset offset between target/fine grid and source/coarse grid
727	!> @param[in] id_iext number of points to be extrapolated in i-direction
728	!> @param[in] id_jext number of points to be extrapolated in j-direction
729	!>
730	!> @todo check if mask is really needed
731	!-------------------------------------------------------------------
732
733	IMPLICIT NONE
734
735	! Argument
736	TYPE(TVAR) , INTENT(INOUT) :: td_var
737	INTEGER(i4), DIMENSION(:) , INTENT(IN ) :: id_rho
738	INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_offset
739	INTEGER(i4), INTENT(IN ), OPTIONAL :: id_iext
740	INTEGER(i4), INTENT(IN ), OPTIONAL :: id_jext
741
742	! local variable
743	TYPE(TVAR) :: tl_mask
744
745	INTEGER(i1), DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
746
747	INTEGER(i4) :: il_iext
748	INTEGER(i4) :: il_jext
749
750	! loop indices
751	!----------------------------------------------------------------
752
753	IF( ANY(SHAPE(id_offset(:,:)) /= 2) )THEN
754	CALL logger_error("CREATE COORD INTERP: invalid dimension of "//&
755	& "offset array")
756	ENDIF
757
758	!WARNING: two extrabands are required for cubic interpolation
759	il_iext=2
760	IF( PRESENT(id_iext) ) il_iext=id_iext
761
762	il_jext=2
763	IF( PRESENT(id_jext) ) il_jext=id_jext
764
765	IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
766	CALL logger_warn("CREATE COORD INTERP: at least extrapolation "//&
767	& "on two points are required with cubic interpolation ")
768	il_iext=2
769	ENDIF
770
771	IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
772	CALL logger_warn("CREATE COORD INTERP: at least extrapolation "//&
773	& "on two points are required with cubic interpolation ")
774	il_jext=2
775	ENDIF
776
777	IF( ANY(id_rho(:)>1) )THEN
778	! work on mask
779	! create mask
780	ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
781	& td_var%t_dim(2)%i_len, &
782	& td_var%t_dim(3)%i_len, &
783	& td_var%t_dim(4)%i_len) )
784
785	bl_mask(:,:,:,:)=1
786	WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0
787
788	SELECT CASE(TRIM(td_var%c_point))
789	CASE DEFAULT ! 'T'
790	tl_mask=var_init('tmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
791	& id_ew=td_var%i_ew )
792	CASE('U')
793	tl_mask=var_init('umask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
794	& id_ew=td_var%i_ew )
795	CASE('V')
796	tl_mask=var_init('vmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
797	& id_ew=td_var%i_ew )
798	CASE('F')
799	tl_mask=var_init('fmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
800	& id_ew=td_var%i_ew )
801	END SELECT
802
803	DEALLOCATE(bl_mask)
804
805	! interpolate mask
806	CALL interp_fill_value( tl_mask, id_rho(:), &
807	& id_offset=id_offset(:,:) )
808
809	! work on variable
810	! add extraband
811	CALL extrap_add_extrabands(td_var, il_iext, il_jext)
812
813	! extrapolate variable
814	CALL extrap_fill_value( td_var )
815
816	! interpolate variable
817	CALL interp_fill_value( td_var, id_rho(:), &
818	& id_offset=id_offset(:,:))
819
820	! remove extraband
821	CALL extrap_del_extrabands(td_var, il_iextid_rho(jp_I), il_jextid_rho(jp_J))
822
823	! keep original mask
824	WHERE( tl_mask%d_value(:,:,:,:) == 0 )
825	td_var%d_value(:,:,:,:)=td_var%d_fill
826	END WHERE
827	ENDIF
828
829	! clean variable structure
830	CALL var_clean(tl_mask)
831
832	END SUBROUTINE create_coord_interp
833	!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
834	END PROGRAM create_coord

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: utils/tools/SIREN/src/create_coord.f90 @ 13369

Download in other formats: