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.

create_restart.f90 in branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src – NEMO

Context Navigation

source: branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/create_restart.f90 @ 6392

Last change on this file since 6392 was 6392, checked in by jpaul, 8 years ago
commit changes/bugfix/... for SIREN; see ticket #1700
File size: 43.9 KB

Line
1	!----------------------------------------------------------------------
2	! NEMO system team, System and Interface for oceanic RElocable Nesting
3	!----------------------------------------------------------------------
4	!
5	!
6	! PROGRAM: create_restart
7	!
8	! DESCRIPTION:
9	!> @file
10	!> @brief
11	!> This program creates restart file.
12	!>
13	!> @details
14	!> @section sec1 method
15	!> Variables could be extracted from fine grid file, interpolated from coarse
16	!> grid file or restart file. Variables could also be manually written.<br/>
17	!> Then they are split over new layout.
18	!> @note
19	!> method could be different for each variable.
20	!>
21	!> @section sec2 how to
22	!> to create restart file:<br/>
23	!> @code{.sh}
24	!> ./SIREN/bin/create_restart create_restart.nam
25	!> @endcode
26	!>
27	!> @note
28	!> you could find a template of the namelist in templates directory.
29	!>
30	!> create_restart.nam contains 9 namelists:<br/>
31	!> - logger namelist (namlog)
32	!> - config namelist (namcfg)
33	!> - coarse grid namelist (namcrs)
34	!> - fine grid namelist (namfin)
35	!> - vertical grid namelist (namzgr)
36	!> - partial step namelist (namzps)
37	!> - variable namelist (namvar)
38	!> - nesting namelist (namnst)
39	!> - output namelist (namout)
40	!>
41	!> * _logger namelist (namlog)_:<br/>
42	!> - cn_logfile : log filename
43	!> - cn_verbosity : verbosity ('trace','debug','info',
44	!> 'warning','error','fatal','none')
45	!> - in_maxerror : maximum number of error allowed
46	!>
47	!> * _config namelist (namcfg)_:<br/>
48	!> - cn_varcfg : variable configuration file
49	!> (see ./SIREN/cfg/variable.cfg)
50	!> - cn_dumcfg : useless (dummy) configuration file, for useless
51	!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
52	!>
53	!> * _coarse grid namelist (namcrs):<br/>
54	!> - cn_coord0 : coordinate file
55	!> - in_perio0 : NEMO periodicity index (see Model Boundary Condition in
56	!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
57	!>
58	!> * _fine grid namelist (namfin)_:<br/>
59	!> - cn_coord1 : coordinate file
60	!> - cn_bathy1 : bathymetry file
61	!> - in_perio1 : NEMO periodicity index
62	!>
63	!> * _vertical grid namelist (namzgr)_:<br/>
64	!> - dn_pp_to_be_computed :
65	!> - dn_ppsur :
66	!> - dn_ppa0 :
67	!> - dn_ppa1 :
68	!> - dn_ppa2 :
69	!> - dn_ppkth :
70	!> - dn_ppkth2 :
71	!> - dn_ppacr :
72	!> - dn_ppacr2 :
73	!> - dn_ppdzmin :
74	!> - dn_pphmax :
75	!> - in_nlevel : number of vertical level
76	!>
77	!> * _partial step namelist (namzps)_:<br/>
78	!> - dn_e3zps_min :
79	!> - dn_e3zps_rat :
80	!>
81	!> * _variable namelist (namvar)_:<br/>
82	!> - cn_varfile : list of variable, and associated file<br/>
83	!> cn_varfile is the path and filename of the file where find
84	!> variable.<br/>
85	!> @note
86	!> cn_varfile could be a matrix of value, if you want to filled
87	!> manually variable value.<br/>
88	!> the variable array of value is split into equal subdomain.<br/>
89	!> Each subdomain is filled with the corresponding value
90	!> of the matrix.<br/>
91	!> separators used to defined matrix are:
92	!> - ',' for line
93	!> - '/' for row
94	!> - '\' for level<br/>
95	!> Example:<br/>
96	!> 3,2,3/1,4,5 => @f$ \left( \begin{array}{ccc}
97	!> 3 & 2 & 3 \\
98	!> 1 & 4 & 5 \end{array} \right) @f$
99	!>
100	!> Examples:
101	!> - 'votemper:gridT.nc', 'vozocrtx:gridU.nc'
102	!> - 'votemper:10\25', 'vozocrtx:gridU.nc'
103	!>
104	!> to get all variable from one file:
105	!> - 'all:restart.dimg'
106	!>
107	!> - cn_varinfo : list of variable and extra information about request(s)
108	!> to be used.<br/>
109	!> each elements of cn_varinfo is a string character
110	!> (separated by ',').<br/>
111	!> it is composed of the variable name follow by ':',
112	!> then request(s) to be used on this variable.<br/>
113	!> request could be:
114	!> - int = interpolation method
115	!> - ext = extrapolation method
116	!> - flt = filter method
117	!> - min = minimum value
118	!> - max = maximum value
119	!> - unt = new units
120	!> - unf = unit scale factor (linked to new units)
121	!>
122	!> requests must be separated by ';'.<br/>
123	!> order of requests does not matter.<br/>
124	!>
125	!> informations about available method could be find in @ref interp,
126	!> @ref extrap and @ref filter.<br/>
127	!> Example: 'votemper: int=linear; flt=hann; ext=dist_weight',
128	!> 'vosaline: int=cubic'
129	!> @note
130	!> If you do not specify a method which is required,
131	!> default one is apply.
132	!>
133	!> * _nesting namelist (namnst)_:<br/>
134	!> - in_rhoi : refinement factor in i-direction
135	!> - in_rhoj : refinement factor in j-direction
136	!> @note
137	!> coarse grid indices will be computed from fine grid
138	!> coordinate file.
139	!>
140	!> * _output namelist (namout)_:<br/>
141	!> - cn_fileout : output file
142	!> - ln_extrap : extrapolate land point or not
143	!> - in_niproc : number of processor in i-direction
144	!> - in_njproc : number of processor in j-direction
145	!> - in_nproc : total number of processor to be used
146	!> - cn_type : output format ('dimg', 'cdf')
147	!>
148	!> @author J.Paul
149	! REVISION HISTORY:
150	!> @date November, 2013 - Initial Version
151	!> @date September, 2014
152	!> - add header for user
153	!> - offset computed considering grid point
154	!> - add attributes in output variable
155	!> @date June, 2015
156	!> - extrapolate all land points, and add ln_extrap in namelist.
157	!> - allow to change unit.
158	!> @date September, 2015
159	!> - manage useless (dummy) variable, attributes, and dimension
160	!>
161	!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
162	!----------------------------------------------------------------------
163	PROGRAM create_restart
164
165	USE global ! global variable
166	USE kind ! F90 kind parameter
167	USE logger ! log file manager
168	USE fct ! basic useful function
169	USE date ! date manager
170	USE att ! attribute manager
171	USE dim ! dimension manager
172	USE var ! variable manager
173	USE file ! file manager
174	USE multi ! multi file manager
175	USE iom ! I/O manager
176	USE grid ! grid manager
177	USE vgrid ! vertical grid manager
178	USE extrap ! extrapolation manager
179	USE interp ! interpolation manager
180	USE filter ! filter manager
181	USE mpp ! MPP manager
182	USE dom ! domain manager
183	USE iom_mpp ! MPP I/O manager
184	USE iom_dom ! DOM I/O manager
185
186	IMPLICIT NONE
187
188	! local variable
189	CHARACTER(LEN=lc) :: cl_namelist
190	CHARACTER(LEN=lc) :: cl_date
191	CHARACTER(LEN=lc) :: cl_name
192	CHARACTER(LEN=lc) :: cl_data
193	CHARACTER(LEN=lc) :: cl_fileout
194
195	INTEGER(i4) :: il_narg
196	INTEGER(i4) :: il_status
197	INTEGER(i4) :: il_fileid
198	INTEGER(i4) :: il_nvar
199	INTEGER(i4) :: il_attid
200	INTEGER(i4) :: il_imin1
201	INTEGER(i4) :: il_imax1
202	INTEGER(i4) :: il_jmin1
203	INTEGER(i4) :: il_jmax1
204	INTEGER(i4) :: il_imin0
205	INTEGER(i4) :: il_imax0
206	INTEGER(i4) :: il_jmin0
207	INTEGER(i4) :: il_jmax0
208	INTEGER(i4) :: il_index
209	INTEGER(i4) , DIMENSION(ip_maxdim) :: il_rho
210	INTEGER(i4) , DIMENSION(2,2) :: il_xghost
211	INTEGER(i4) , DIMENSION(2,2) :: il_offset
212	INTEGER(i4) , DIMENSION(2,2) :: il_ind
213
214	LOGICAL :: ll_exist
215	LOGICAL :: ll_sameGrid
216
217	TYPE(TDOM) :: tl_dom1
218	TYPE(TDOM) :: tl_dom0
219
220	TYPE(TATT) :: tl_att
221
222	TYPE(TVAR) :: tl_depth
223	TYPE(TVAR) :: tl_time
224	TYPE(TVAR) :: tl_lon
225	TYPE(TVAR) :: tl_lat
226	TYPE(TVAR) , DIMENSION(:) , ALLOCATABLE :: tl_var
227	TYPE(TVAR) , DIMENSION(:) , ALLOCATABLE :: tl_level
228
229	TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
230
231	TYPE(TMPP) :: tl_coord0
232	TYPE(TMPP) :: tl_coord1
233	TYPE(TMPP) :: tl_bathy1
234	TYPE(TMPP) :: tl_mpp
235	TYPE(TMPP) :: tl_mppout
236
237	TYPE(TMULTI) :: tl_multi
238
239	! loop indices
240	INTEGER(i4) :: ji
241	INTEGER(i4) :: jj
242	INTEGER(i4) :: jvar
243
244	! namelist variable
245	! namlog
246	CHARACTER(LEN=lc) :: cn_logfile = 'create_restart.log'
247	CHARACTER(LEN=lc) :: cn_verbosity = 'warning'
248	INTEGER(i4) :: in_maxerror = 5
249
250	! namcfg
251	CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg'
252	CHARACTER(LEN=lc) :: cn_dumcfg = 'dummy.cfg'
253
254	! namcrs
255	CHARACTER(LEN=lc) :: cn_coord0 = ''
256	INTEGER(i4) :: in_perio0 = -1
257
258	! namfin
259	CHARACTER(LEN=lc) :: cn_coord1 = ''
260	CHARACTER(LEN=lc) :: cn_bathy1 = ''
261	INTEGER(i4) :: in_perio1 = -1
262
263	!namzgr
264	REAL(dp) :: dn_pp_to_be_computed = 0._dp
265	REAL(dp) :: dn_ppsur = -3958.951371276829_dp
266	REAL(dp) :: dn_ppa0 = 103.953009600000_dp
267	REAL(dp) :: dn_ppa1 = 2.415951269000_dp
268	REAL(dp) :: dn_ppa2 = 100.760928500000_dp
269	REAL(dp) :: dn_ppkth = 15.351013700000_dp
270	REAL(dp) :: dn_ppkth2 = 48.029893720000_dp
271	REAL(dp) :: dn_ppacr = 7.000000000000_dp
272	REAL(dp) :: dn_ppacr2 = 13.000000000000_dp
273	REAL(dp) :: dn_ppdzmin = 6._dp
274	REAL(dp) :: dn_pphmax = 5750._dp
275	INTEGER(i4) :: in_nlevel = 75
276
277	!namzps
278	REAL(dp) :: dn_e3zps_min = 25._dp
279	REAL(dp) :: dn_e3zps_rat = 0.2_dp
280
281	! namvar
282	CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
283	CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
284
285	! namnst
286	INTEGER(i4) :: in_rhoi = 0
287	INTEGER(i4) :: in_rhoj = 0
288
289	! namout
290	CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc'
291	LOGICAL :: ln_extrap = .FALSE.
292	INTEGER(i4) :: in_nproc = 0
293	INTEGER(i4) :: in_niproc = 0
294	INTEGER(i4) :: in_njproc = 0
295	CHARACTER(LEN=lc) :: cn_type = ''
296
297	!-------------------------------------------------------------------
298
299	NAMELIST /namlog/ & !< logger namelist
300	& cn_logfile, & !< log file
301	& cn_verbosity, & !< log verbosity
302	& in_maxerror !< logger maximum error
303
304	NAMELIST /namcfg/ & !< configuration namelist
305	& cn_varcfg, & !< variable configuration file
306	& cn_dumcfg !< dummy configuration file
307
308	NAMELIST /namcrs/ & !< coarse grid namelist
309	& cn_coord0, & !< coordinate file
310	& in_perio0 !< periodicity index
311
312	NAMELIST /namfin/ & !< fine grid namelist
313	& cn_coord1, & !< coordinate file
314	& cn_bathy1, & !< bathymetry file
315	& in_perio1 !< periodicity index
316
317	NAMELIST /namzgr/ &
318	& dn_pp_to_be_computed, &
319	& dn_ppsur, &
320	& dn_ppa0, &
321	& dn_ppa1, &
322	& dn_ppa2, &
323	& dn_ppkth, &
324	& dn_ppkth2, &
325	& dn_ppacr, &
326	& dn_ppacr2, &
327	& dn_ppdzmin, &
328	& dn_pphmax, &
329	& in_nlevel !< number of vertical level
330
331	NAMELIST /namzps/ &
332	& dn_e3zps_min, &
333	& dn_e3zps_rat
334
335	NAMELIST /namvar/ & !< variable namelist
336	& cn_varfile, & !< list of variable file
337	& cn_varinfo !< list of variable and interpolation method to be used.
338
339	NAMELIST /namnst/ & !< nesting namelist
340	& in_rhoi, & !< refinement factor in i-direction
341	& in_rhoj !< refinement factor in j-direction
342
343	NAMELIST /namout/ & !< output namlist
344	& cn_fileout, & !< fine grid bathymetry file
345	& ln_extrap, & !< extrapolate or not
346	& in_niproc, & !< i-direction number of processor
347	& in_njproc, & !< j-direction numebr of processor
348	& in_nproc, & !< number of processor to be used
349	& cn_type !< output type format (dimg, cdf)
350	!-------------------------------------------------------------------
351
352	! namelist
353	! get namelist
354	il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
355	IF( il_narg/=1 )THEN
356	PRINT *,"ERROR in create_restart: need a namelist"
357	STOP
358	ELSE
359	CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
360	ENDIF
361
362	! read namelist
363	INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
364	IF( ll_exist )THEN
365
366	il_fileid=fct_getunit()
367
368	OPEN( il_fileid, FILE=TRIM(cl_namelist), &
369	& FORM='FORMATTED', &
370	& ACCESS='SEQUENTIAL', &
371	& STATUS='OLD', &
372	& ACTION='READ', &
373	& IOSTAT=il_status)
374	CALL fct_err(il_status)
375	IF( il_status /= 0 )THEN
376	PRINT *,"ERROR in create_restart: error opening "//TRIM(cl_namelist)
377	STOP
378	ENDIF
379
380	READ( il_fileid, NML = namlog )
381	! define log file
382	CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
383	CALL logger_header()
384
385	READ( il_fileid, NML = namcfg )
386	! get variable extra information
387	CALL var_def_extra(TRIM(cn_varcfg))
388
389	! get dummy variable
390	CALL var_get_dummy(TRIM(cn_dumcfg))
391	! get dummy dimension
392	CALL dim_get_dummy(TRIM(cn_dumcfg))
393	! get dummy attribute
394	CALL att_get_dummy(TRIM(cn_dumcfg))
395
396	READ( il_fileid, NML = namcrs )
397	READ( il_fileid, NML = namfin )
398	READ( il_fileid, NML = namzgr )
399	READ( il_fileid, NML = namvar )
400	! add user change in extra information
401	CALL var_chg_extra(cn_varinfo)
402	! match variable with file
403	tl_multi=multi_init(cn_varfile)
404
405	READ( il_fileid, NML = namnst )
406	READ( il_fileid, NML = namout )
407
408	CLOSE( il_fileid, IOSTAT=il_status )
409	CALL fct_err(il_status)
410	IF( il_status /= 0 )THEN
411	CALL logger_error("CREATE RESTART: closing "//TRIM(cl_namelist))
412	ENDIF
413
414	ELSE
415
416	PRINT *,"ERROR in create_restart: can't find "//TRIM(cl_namelist)
417	STOP
418
419	ENDIF
420
421	!
422	CALL multi_print(tl_multi)
423	IF( tl_multi%i_nvar <= 0 )THEN
424	CALL logger_fatal("CREATE RESTART: no variable to be used."//&
425	& " check namelist.")
426	ENDIF
427
428	! open files
429	IF( cn_coord0 /= '' )THEN
430	tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
431	CALL grid_get_info(tl_coord0)
432	ELSE
433	CALL logger_fatal("CREATE RESTART: no coarse grid coordinate found. "//&
434	& "check namelist")
435	ENDIF
436
437	IF( TRIM(cn_coord1) /= '' )THEN
438	tl_coord1=mpp_init( file_init(TRIM(cn_coord1)), id_perio=in_perio1)
439	CALL grid_get_info(tl_coord1)
440	ELSE
441	CALL logger_fatal("CREATE RESTART: no fine grid coordinate found. "//&
442	& "check namelist")
443	ENDIF
444
445	IF( TRIM(cn_bathy1) /= '' )THEN
446	tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1)
447	CALL grid_get_info(tl_bathy1)
448	ELSE
449	CALL logger_fatal("CREATE RESTART: no fine grid bathymetry found. "//&
450	& "check namelist")
451	ENDIF
452
453	! check
454	! check output file do not already exist
455	IF( in_nproc > 0 )THEN
456	cl_fileout=file_rename(cn_fileout,1)
457	ELSE
458	cl_fileout=file_rename(cn_fileout)
459	ENDIF
460	INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist)
461	IF( ll_exist )THEN
462	CALL logger_fatal("CREATE RESTART: output file "//TRIM(cl_fileout)//&
463	& " already exist.")
464	ENDIF
465
466	! check refinement factor
467	il_rho(:)=1
468	IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
469	CALL logger_error("CREATE RESTART: invalid refinement factor."//&
470	& " check namelist "//TRIM(cl_namelist))
471	ELSE
472	il_rho(jp_I)=in_rhoi
473	il_rho(jp_J)=in_rhoj
474	ENDIF
475
476	! check domain indices
477	! compute coarse grid indices around fine grid
478	il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, &
479	& id_rho=il_rho(:))
480
481	il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2)
482	il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2)
483
484	! check domain validity
485	CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0)
486
487	!3-2-4 check coincidence between coarse and fine grid
488	CALL grid_check_coincidence( tl_coord0, tl_coord1, &
489	& il_imin0, il_imax0, &
490	& il_jmin0, il_jmax0, &
491	& il_rho(:) )
492
493	! fine grid ghost cell
494	il_xghost(:,:)=grid_get_ghost(tl_bathy1)
495
496	! work on variables
497	IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
498	CALL logger_error("CREATE RESTART: no file to work on. "//&
499	& "check cn_varfile in namelist.")
500	ELSE
501	ALLOCATE( tl_var( tl_multi%i_nvar ) )
502
503	jvar=0
504	! for each file
505	DO ji=1,tl_multi%i_nmpp
506	WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1
507
508	IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
509
510	CALL logger_error("CREATE RESTART: no variable to work on for "//&
511	& "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//&
512	& ". check cn_varfile in namelist.")
513
514	ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN
515	!- use input matrix to fill variable
516
517	WRITE(*,'(a)') "work on data"
518	! for each variable initialise from matrix
519	DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
520
521	jvar=jvar+1
522
523	WRITE(*,'(2x,a,a)') "work on variable "//&
524	& TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
525
526	! fill value with matrix data
527	tl_var(jvar) = create_restart_matrix( &
528	& tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, &
529	& in_nlevel, il_xghost(:,:) )
530
531	! add ghost cell
532	CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:))
533
534	ENDDO
535	!- end of use input matrix to fill variable
536	ELSE
537	!- use mpp file to fill variable
538
539	WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name)
540	!
541	tl_mpp=mpp_init( file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name)) )
542	CALL grid_get_info(tl_mpp)
543
544	! check vertical dimension
545	IF( tl_mpp%t_dim(jp_K)%l_use .AND. &
546	& tl_mpp%t_dim(jp_K)%i_len /= in_nlevel )THEN
547	CALL logger_error("CREATE RESTART: dimension in file "//&
548	& TRIM(tl_mpp%c_name)//" not agree with namelist in_nlevel ")
549	ENDIF
550
551	! open mpp file
552	CALL iom_mpp_open(tl_mpp)
553
554	! get or check depth value
555	CALL create_restart_check_depth( tl_mpp, tl_depth )
556
557	! get or check time value
558	CALL create_restart_check_time( tl_mpp, tl_time )
559
560	! close mpp file
561	CALL iom_mpp_close(tl_mpp)
562
563	IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) .OR.&
564	& ALL(il_rho(:)==1) )THEN
565	!!! extract value from fine grid
566
567	IF( ANY( tl_mpp%t_dim(1:2)%i_len < &
568	& tl_coord1%t_dim(1:2)%i_len) )THEN
569	CALL logger_fatal("CREATE RESTART: dimensions in file "//&
570	& TRIM(tl_mpp%c_name)//" smaller than those in fine"//&
571	& " grid coordinates.")
572	ENDIF
573
574	! use coord0 instead of mpp for restart file case
575	! (without lon,lat)
576	ll_sameGrid=.FALSE.
577	IF( ALL(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) &
578	& )THEN
579	ll_sameGrid=.TRUE.
580	ENDIF
581
582	! compute domain on fine grid
583	IF( ll_sameGrid )THEN
584	il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 )
585	ELSE
586	il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1 )
587	ENDIF
588
589	il_imin1=il_ind(1,1) ; il_imax1=il_ind(1,2)
590	il_jmin1=il_ind(2,1) ; il_jmax1=il_ind(2,2)
591
592	!- check grid coincidence
593	IF( ll_sameGrid )THEN
594	CALL grid_check_coincidence( tl_mpp, tl_coord1, &
595	& il_imin1, il_imax1, &
596	& il_jmin1, il_jmax1, &
597	& il_rho(:) )
598	ELSE
599	CALL grid_check_coincidence( tl_coord0, tl_coord1, &
600	& il_imin1, il_imax1, &
601	& il_jmin1, il_jmax1, &
602	& il_rho(:) )
603	ENDIF
604
605	! compute domain
606	tl_dom1=dom_init(tl_mpp, &
607	& il_imin1, il_imax1, &
608	& il_jmin1, il_jmax1)
609
610	! open mpp files
611	CALL iom_dom_open(tl_mpp, tl_dom1)
612
613	! for each variable of this file
614	DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
615
616	WRITE(*,'(2x,a,a)') "work on (extract) variable "//&
617	& TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
618
619	jvar=jvar+1
620	cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name
621	! read variable over domain
622	tl_var(jvar)=iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom1)
623
624	! add attribute to variable
625	tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
626	CALL var_move_att(tl_var(jvar), tl_att)
627
628	tl_att=att_init('src_i_indices',(/il_imin0, il_imax0/))
629	CALL var_move_att(tl_var(jvar), tl_att)
630
631	tl_att=att_init('src_j_indices',(/il_jmin0, il_jmax0/))
632	CALL var_move_att(tl_var(jvar), tl_att)
633
634	! clean structure
635	CALL att_clean(tl_att)
636
637	! add ghost cell
638	CALL grid_add_ghost(tl_var(jvar), tl_dom1%i_ghost(:,:))
639
640	ENDDO
641
642	! close mpp file
643	CALL iom_dom_close(tl_mpp)
644
645	! clean structure
646	CALL mpp_clean(tl_mpp)
647	CALL dom_clean(tl_dom1)
648
649	ELSE
650	!!! get value from coarse grid
651
652	! compute domain on coarse grid
653	tl_dom0=dom_init(tl_mpp, &
654	& il_imin0, il_imax0, &
655	& il_jmin0, il_jmax0 )
656
657	! add extra band (if possible) to compute interpolation
658	CALL dom_add_extra(tl_dom0)
659
660	! open mpp files
661	CALL iom_dom_open(tl_mpp, tl_dom0)
662	! for each variable of this file
663	DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
664
665	WRITE(*,'(2x,a,a)') "work on (interp) variable "//&
666	& TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
667
668	jvar=jvar+1
669	cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name
670
671	! read variable over domain
672	tl_var(jvar)=iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0)
673
674	il_offset(:,:)=grid_get_fine_offset(tl_coord0, &
675	& il_imin0, il_jmin0, &
676	& il_imax0, il_jmax0, &
677	& tl_coord1, &
678	& id_rho=il_rho(:), &
679	& cd_point=TRIM(tl_var(jvar)%c_point))
680
681	! interpolate variable
682	CALL create_restart_interp(tl_var(jvar), &
683	& il_rho(:), &
684	& id_offset=il_offset(:,:))
685
686	! remove extraband added to domain
687	CALL dom_del_extra( tl_var(jvar), tl_dom0, il_rho(:) )
688
689	! add attribute to variable
690	tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
691	CALL var_move_att(tl_var(jvar), tl_att)
692
693	tl_att=att_init('src_i-indices',(/il_imin0, il_imax0/))
694	CALL var_move_att(tl_var(jvar), tl_att)
695
696	tl_att=att_init('src_j-indices',(/il_jmin0, il_jmax0/))
697	CALL var_move_att(tl_var(jvar), tl_att)
698
699	IF( ANY(il_rho(:)/=1) )THEN
700	tl_att=att_init("refinment_factor", &
701	& (/il_rho(jp_I),il_rho(jp_J)/))
702	CALL var_move_att(tl_var(jvar), tl_att)
703	ENDIF
704
705	! clean structure
706	CALL att_clean(tl_att)
707
708	! add ghost cell
709	CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:))
710	ENDDO
711
712	! close mpp file
713	CALL iom_dom_close(tl_mpp)
714
715	! clean structure
716	CALL mpp_clean(tl_mpp)
717	CALL dom_clean(tl_dom0)
718
719	ENDIF
720
721	! clean structure
722	CALL mpp_clean(tl_mpp)
723	ENDIF
724	ENDDO
725	ENDIF
726
727	il_nvar=tl_multi%i_nvar
728
729	! clean
730	CALL multi_clean(tl_multi)
731	CALL mpp_clean(tl_coord0)
732
733	IF( .NOT. ln_extrap )THEN
734	! compute level
735	ALLOCATE(tl_level(ip_npoint))
736	tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
737	ENDIF
738
739	! clean
740	CALL mpp_clean(tl_bathy1)
741
742	! use additional request
743	DO jvar=1,il_nvar
744
745	! change unit and apply factor
746	CALL var_chg_unit(tl_var(jvar))
747
748	! forced min and max value
749	CALL var_limit_value(tl_var(jvar))
750
751	! filter
752	CALL filter_fill_value(tl_var(jvar))
753
754	IF( .NOT. ln_extrap )THEN
755	! use mask
756	CALL create_restart_mask(tl_var(jvar), tl_level(:))
757	ENDIF
758
759	ENDDO
760
761	! create file
762	IF( in_niproc == 0 .AND. &
763	& in_njproc == 0 .AND. &
764	& in_nproc == 0 )THEN
765	in_niproc = 1
766	in_njproc = 1
767	in_nproc = 1
768	ENDIF
769
770	! add dimension
771	tl_dim(:)=var_max_dim(tl_var(:))
772
773	DO ji=1,il_nvar
774
775	IF( ALL(tl_var(ji)%t_dim(:)%i_len == tl_dim(:)%i_len) )THEN
776	tl_mppout=mpp_init( TRIM(cn_fileout), tl_var(ji), &
777	& in_niproc, in_njproc, in_nproc, &
778	& cd_type=cn_type)
779	EXIT
780	ENDIF
781
782	ENDDO
783
784	DO ji=1,ip_maxdim
785
786	IF( tl_dim(ji)%l_use )THEN
787	CALL mpp_move_dim(tl_mppout, tl_dim(ji))
788	SELECT CASE(TRIM(tl_dim(ji)%c_sname))
789	CASE('z','t')
790	DO jj=1,tl_mppout%i_nproc
791	CALL file_add_dim(tl_mppout%t_proc(jj), tl_dim(ji))
792	ENDDO
793	END SELECT
794	ENDIF
795
796	ENDDO
797
798	! add variables
799	IF( ALL( tl_dim(1:2)%l_use ) )THEN
800
801	! open mpp files
802	CALL iom_mpp_open(tl_coord1)
803
804	! add longitude
805	tl_lon=iom_mpp_read_var(tl_coord1,'longitude')
806	CALL mpp_add_var(tl_mppout, tl_lon)
807	CALL var_clean(tl_lon)
808
809	! add latitude
810	tl_lat=iom_mpp_read_var(tl_coord1,'latitude')
811	CALL mpp_add_var(tl_mppout, tl_lat)
812	CALL var_clean(tl_lat)
813
814	! close mpp files
815	CALL iom_mpp_close(tl_coord1)
816
817	ENDIF
818
819	IF( tl_dim(3)%l_use )THEN
820	IF( ASSOCIATED(tl_depth%d_value) )THEN
821	! add depth
822	CALL mpp_add_var(tl_mppout, tl_depth)
823	ELSE
824	CALL logger_warn("CREATE RESTART: no value for depth variable.")
825	ENDIF
826	ENDIF
827	IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth)
828
829	IF( tl_dim(4)%l_use )THEN
830	IF( ASSOCIATED(tl_time%d_value) )THEN
831	! add time
832	CALL mpp_add_var(tl_mppout, tl_time)
833	ELSE
834	CALL logger_warn("CREATE RESTART: no value for time variable.")
835	ENDIF
836	ENDIF
837	IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time)
838
839	! add other variable
840	DO jvar=il_nvar,1,-1
841	! check if variable already add
842	il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name)
843	IF( il_index == 0 )THEN
844	CALL mpp_add_var(tl_mppout, tl_var(jvar))
845	CALL var_clean(tl_var(jvar))
846	ENDIF
847	ENDDO
848
849	! add some attribute
850	tl_att=att_init("Created_by","SIREN create_restart")
851	CALL mpp_add_att(tl_mppout, tl_att)
852
853	cl_date=date_print(date_now())
854	tl_att=att_init("Creation_date",TRIM(cl_date))
855	CALL mpp_add_att(tl_mppout, tl_att)
856
857	! add attribute periodicity
858	il_attid=0
859	IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN
860	il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'periodicity')
861	ENDIF
862	IF( tl_coord1%i_perio >= 0 .AND. il_attid == 0 )THEN
863	tl_att=att_init('periodicity',tl_coord1%i_perio)
864	CALL mpp_add_att(tl_mppout,tl_att)
865	ENDIF
866
867	il_attid=0
868	IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN
869	il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'ew_overlap')
870	ENDIF
871	IF( tl_coord1%i_ew >= 0 .AND. il_attid == 0 )THEN
872	tl_att=att_init('ew_overlap',tl_coord1%i_ew)
873	CALL mpp_add_att(tl_mppout,tl_att)
874	ENDIF
875
876	! print
877	CALL mpp_print(tl_mppout)
878
879	! create file
880	CALL iom_mpp_create(tl_mppout)
881
882	! write file
883	CALL iom_mpp_write_file(tl_mppout)
884	! close file
885	CALL iom_mpp_close(tl_mppout)
886
887	! clean
888	CALL att_clean(tl_att)
889	CALL var_clean(tl_var(:))
890	DEALLOCATE(tl_var)
891	IF( .NOT. ln_extrap )THEN
892	CALL var_clean(tl_level(:))
893	DEALLOCATE(tl_level)
894	ENDIF
895
896	CALL mpp_clean(tl_mppout)
897	CALL mpp_clean(tl_coord1)
898
899	! close log file
900	CALL logger_footer()
901	CALL logger_close()
902
903	CONTAINS
904	!-------------------------------------------------------------------
905	!> @brief
906	!> This function create variable, filled with matrix value
907	!>
908	!> @details
909	!> A variable is create with the same name that the input variable,
910	!> and with dimension of the coordinate file.<br/>
911	!> Then the variable array of value is split into equal subdomain.
912	!> Each subdomain is filled with the associated value of the matrix.
913	!>
914	!> @author J.Paul
915	!> @date November, 2013 - Initial Version
916	!> @date June, 2015
917	!> - do not use level anymore
918	!>
919	!> @param[in] td_var variable structure
920	!> @param[in] td_coord coordinate file structure
921	!> @param[in] id_nlevel number of vertical level
922	!> @param[in] id_xghost ghost cell array
923	!> @return variable structure
924	!-------------------------------------------------------------------
925	FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, id_xghost)
926	IMPLICIT NONE
927	! Argument
928	TYPE(TVAR) , INTENT(IN) :: td_var
929	TYPE(TMPP) , INTENT(IN) :: td_coord
930	INTEGER(i4) , INTENT(IN) :: id_nlevel
931	INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_xghost
932
933	! function
934	TYPE(TVAR) :: create_restart_matrix
935
936	! local variable
937	INTEGER(i4) , DIMENSION(3) :: il_dim
938	INTEGER(i4) , DIMENSION(3) :: il_size
939	INTEGER(i4) , DIMENSION(3) :: il_rest
940
941	INTEGER(i4) , DIMENSION(:) , ALLOCATABLE :: il_ishape
942	INTEGER(i4) , DIMENSION(:) , ALLOCATABLE :: il_jshape
943	INTEGER(i4) , DIMENSION(:) , ALLOCATABLE :: il_kshape
944
945	REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
946
947	TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
948
949	! loop indices
950	INTEGER(i4) :: ji
951	INTEGER(i4) :: jj
952	INTEGER(i4) :: jk
953	!----------------------------------------------------------------
954
955	! write value on grid
956	! get matrix dimension
957	il_dim(:)=td_var%t_dim(1:3)%i_len
958
959	! output dimension
960	tl_dim(jp_I:jp_J)=dim_copy(td_coord%t_dim(jp_I:jp_J))
961	IF( id_nlevel >= 1 )THEN
962	tl_dim(jp_K)=dim_init('Z',id_nlevel)
963	ENDIF
964
965	! remove ghost cell
966	tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(id_xghost(jp_I,:))*ip_ghost
967	tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(id_xghost(jp_J,:))*ip_ghost
968
969	! split output domain in N subdomain depending of matrix dimension
970	il_size(:) = tl_dim(1:3)%i_len / il_dim(:)
971	il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:))
972
973	ALLOCATE( il_ishape(il_dim(1)+1) )
974	il_ishape(:)=0
975	DO ji=2,il_dim(1)+1
976	il_ishape(ji)=il_ishape(ji-1)+il_size(1)
977	ENDDO
978	! add rest to last cell
979	il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1)
980
981	ALLOCATE( il_jshape(il_dim(2)+1) )
982	il_jshape(:)=0
983	DO jj=2,il_dim(2)+1
984	il_jshape(jj)=il_jshape(jj-1)+il_size(2)
985	ENDDO
986	! add rest to last cell
987	il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2)
988
989	ALLOCATE( il_kshape(il_dim(3)+1) )
990	il_kshape(:)=0
991	DO jk=2,il_dim(3)+1
992	il_kshape(jk)=il_kshape(jk-1)+il_size(3)
993	ENDDO
994	! add rest to last cell
995	il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3)
996
997	! write ouput array of value
998	ALLOCATE(dl_value( tl_dim(1)%i_len, &
999	& tl_dim(2)%i_len, &
1000	& tl_dim(3)%i_len, &
1001	& tl_dim(4)%i_len) )
1002
1003	dl_value(:,:,:,:)=0
1004
1005	DO jk=2,il_dim(3)+1
1006	DO jj=2,il_dim(2)+1
1007	DO ji=2,il_dim(1)+1
1008
1009	dl_value( 1+il_ishape(ji-1):il_ishape(ji), &
1010	& 1+il_jshape(jj-1):il_jshape(jj), &
1011	& 1+il_kshape(jk-1):il_kshape(jk), &
1012	& 1 ) = td_var%d_value(ji-1,jj-1,jk-1,1)
1013
1014	ENDDO
1015	ENDDO
1016	ENDDO
1017
1018	! keep attribute and type
1019	create_restart_matrix=var_copy(td_var)
1020	DEALLOCATE( create_restart_matrix%d_value )
1021	! save new dimension
1022	create_restart_matrix%t_dim(:)=dim_copy(tl_dim(:))
1023	! add variable value
1024	CALL var_add_value( create_restart_matrix, dl_value(:,:,:,:), &
1025	& id_type=td_var%i_type)
1026
1027	DEALLOCATE(dl_value)
1028
1029	! clean
1030	DEALLOCATE(il_ishape)
1031	DEALLOCATE(il_jshape)
1032	DEALLOCATE(il_kshape)
1033
1034	END FUNCTION create_restart_matrix
1035	!-------------------------------------------------------------------
1036	!> @brief
1037	!> This subroutine use mask to filled land point with _FillValue
1038	!>
1039	!> @author J.Paul
1040	!> @date November, 2013 - Initial Version
1041	!>
1042	!> @param[inout] td_var variable structure
1043	!> @param[in] td_mask mask variable structure
1044	!-------------------------------------------------------------------
1045	SUBROUTINE create_restart_mask( td_var, td_mask )
1046
1047	IMPLICIT NONE
1048
1049	! Argument
1050	TYPE(TVAR) , INTENT(INOUT) :: td_var
1051	TYPE(TVAR), DIMENSION(:), INTENT(IN ) :: td_mask
1052
1053	! local variable
1054	INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_mask
1055
1056	! loop indices
1057	INTEGER(i4) :: jl
1058	INTEGER(i4) :: jk
1059	!----------------------------------------------------------------
1060
1061	IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
1062	IF( ANY(td_var%t_dim(1:2)%i_len /= td_mask(1)%t_dim(1:2)%i_len) )THEN
1063	CALL logger_error("CREATE RESTART MASK: dimension differ between"//&
1064	& " variable "//TRIM(td_var%c_name)//" ("//&
1065	& TRIM(fct_str(td_var%t_dim(1)%i_len))//","//&
1066	& TRIM(fct_str(td_var%t_dim(2)%i_len))//&
1067	& ") and level ("//&
1068	& TRIM(fct_str(td_mask(1)%t_dim(1)%i_len))//","//&
1069	& TRIM(fct_str(td_mask(1)%t_dim(2)%i_len))//")")
1070	ELSE
1071	ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &
1072	& td_var%t_dim(2)%i_len) )
1073
1074	SELECT CASE(TRIM(td_var%c_point))
1075	CASE('T')
1076	il_mask(:,:)=INT(td_mask(jp_T)%d_value(:,:,1,1))
1077	CASE('U')
1078	il_mask(:,:)=INT(td_mask(jp_U)%d_value(:,:,1,1))
1079	CASE('V')
1080	il_mask(:,:)=INT(td_mask(jp_V)%d_value(:,:,1,1))
1081	CASE('F')
1082	il_mask(:,:)=INT(td_mask(jp_F)%d_value(:,:,1,1))
1083	END SELECT
1084
1085	DO jl=1,td_var%t_dim(4)%i_len
1086	DO jk=1,td_var%t_dim(3)%i_len
1087	WHERE( il_mask(:,:) < jk )
1088	td_var%d_value(:,:,jk,jl)=td_var%d_fill
1089	END WHERE
1090	ENDDO
1091	ENDDO
1092
1093	DEALLOCATE( il_mask )
1094	ENDIF
1095	ENDIF
1096	END SUBROUTINE create_restart_mask
1097	!-------------------------------------------------------------------
1098	!> @brief
1099	!> This subroutine interpolate variable
1100	!>
1101	!> @author J.Paul
1102	!> @date November, 2013 - Initial Version
1103	!> @date June, 2015
1104	!> - do not use level anymore (for extrapolation)
1105	!>
1106	!> @param[inout] td_var variable structure
1107	!> @param[in] id_rho array of refinment factor
1108	!> @param[in] id_offset array of offset between fine and coarse grid
1109	!> @param[in] id_iext i-direction size of extra bands (default=im_minext)
1110	!> @param[in] id_jext j-direction size of extra bands (default=im_minext)
1111	!-------------------------------------------------------------------
1112	SUBROUTINE create_restart_interp( td_var, &
1113	& id_rho, &
1114	& id_offset, &
1115	& id_iext, id_jext)
1116
1117	IMPLICIT NONE
1118
1119	! Argument
1120	TYPE(TVAR) , INTENT(INOUT) :: td_var
1121	INTEGER(i4), DIMENSION(:) , INTENT(IN ) :: id_rho
1122	INTEGER(i4), DIMENSION(:,:), INTENT(IN ) :: id_offset
1123	INTEGER(i4), INTENT(IN ), OPTIONAL :: id_iext
1124	INTEGER(i4), INTENT(IN ), OPTIONAL :: id_jext
1125
1126	! local variable
1127	INTEGER(i4) :: il_iext
1128	INTEGER(i4) :: il_jext
1129
1130	! loop indices
1131	!----------------------------------------------------------------
1132
1133	il_iext=3
1134	IF( PRESENT(id_iext) ) il_iext=id_iext
1135
1136	il_jext=3
1137	IF( PRESENT(id_jext) ) il_jext=id_jext
1138
1139	IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
1140	CALL logger_warn("CREATE RESTART INTERP: at least extrapolation "//&
1141	& "on two points are required with cubic interpolation ")
1142	il_iext=2
1143	ENDIF
1144
1145	IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
1146	CALL logger_warn("CREATE RESTART INTERP: at least extrapolation "//&
1147	& "on two points are required with cubic interpolation ")
1148	il_jext=2
1149	ENDIF
1150	! work on variable
1151	! add extraband
1152	CALL extrap_add_extrabands(td_var, il_iext, il_jext)
1153
1154	! extrapolate variable
1155	CALL extrap_fill_value( td_var )
1156
1157	! interpolate variable
1158	CALL interp_fill_value( td_var, id_rho(:), &
1159	& id_offset=id_offset(:,:) )
1160
1161	! remove extraband
1162	CALL extrap_del_extrabands(td_var, il_iextid_rho(jp_I), il_jextid_rho(jp_J))
1163
1164	END SUBROUTINE create_restart_interp
1165	!-------------------------------------------------------------------
1166	!> @brief
1167	!> This subroutine get depth variable value in an open mpp structure
1168	!> and check if agree with already input depth variable.
1169	!>
1170	!> @details
1171	!>
1172	!> @author J.Paul
1173	!> @date November, 2014 - Initial Version
1174	!>
1175	!> @param[in] td_mpp mpp structure
1176	!> @param[inout] td_depth depth variable structure
1177	!-------------------------------------------------------------------
1178	SUBROUTINE create_restart_check_depth( td_mpp, td_depth )
1179
1180	IMPLICIT NONE
1181
1182	! Argument
1183	TYPE(TMPP), INTENT(IN ) :: td_mpp
1184	TYPE(TVAR), INTENT(INOUT) :: td_depth
1185
1186	! local variable
1187	INTEGER(i4) :: il_varid
1188	TYPE(TVAR) :: tl_depth
1189	! loop indices
1190	!----------------------------------------------------------------
1191
1192	! get or check depth value
1193	IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
1194
1195	il_varid=td_mpp%t_proc(1)%i_depthid
1196	IF( ASSOCIATED(td_depth%d_value) )THEN
1197
1198	tl_depth=iom_mpp_read_var(td_mpp, il_varid)
1199	IF( ANY( td_depth%d_value(:,:,:,:) /= &
1200	& tl_depth%d_value(:,:,:,:) ) )THEN
1201
1202	CALL logger_warn("CREATE BOUNDARY: depth value from "//&
1203	& TRIM(td_mpp%c_name)//" not conform "//&
1204	& " to those from former file(s).")
1205
1206	ENDIF
1207	CALL var_clean(tl_depth)
1208
1209	ELSE
1210	td_depth=iom_mpp_read_var(td_mpp,il_varid)
1211	ENDIF
1212
1213	ENDIF
1214
1215	END SUBROUTINE create_restart_check_depth
1216	!-------------------------------------------------------------------
1217	!> @brief
1218	!> This subroutine get date and time in an open mpp structure
1219	!> and check if agree with date and time already read.
1220	!>
1221	!> @details
1222	!>
1223	!> @author J.Paul
1224	!> @date November, 2014 - Initial Version
1225	!>
1226	!> @param[in] td_mpp mpp structure
1227	!> @param[inout] td_time time variable structure
1228	!-------------------------------------------------------------------
1229	SUBROUTINE create_restart_check_time( td_mpp, td_time )
1230
1231	IMPLICIT NONE
1232
1233	! Argument
1234	TYPE(TMPP), INTENT(IN ) :: td_mpp
1235	TYPE(TVAR), INTENT(INOUT) :: td_time
1236
1237	! local variable
1238	INTEGER(i4) :: il_varid
1239	TYPE(TVAR) :: tl_time
1240
1241	TYPE(TDATE) :: tl_date1
1242	TYPE(TDATE) :: tl_date2
1243	! loop indices
1244	!----------------------------------------------------------------
1245
1246	! get or check depth value
1247
1248	IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
1249
1250	il_varid=td_mpp%t_proc(1)%i_timeid
1251	IF( ASSOCIATED(td_time%d_value) )THEN
1252
1253	tl_time=iom_mpp_read_var(td_mpp, il_varid)
1254
1255	tl_date1=var_to_date(td_time)
1256	tl_date2=var_to_date(tl_time)
1257	IF( tl_date1 - tl_date2 /= 0 )THEN
1258
1259	CALL logger_warn("CREATE BOUNDARY: date from "//&
1260	& TRIM(td_mpp%c_name)//" not conform "//&
1261	& " to those from former file(s).")
1262
1263	ENDIF
1264	CALL var_clean(tl_time)
1265
1266	ELSE
1267	td_time=iom_mpp_read_var(td_mpp,il_varid)
1268	ENDIF
1269
1270	ENDIF
1271
1272	END SUBROUTINE create_restart_check_time
1273	END PROGRAM create_restart

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

Download in other formats: