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 @ 8862

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

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

Download in other formats: