source: branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/create_restart.f90 @ 5600

Last change on this file since 5600 was 5600, checked in by andrewryan, 5 years ago

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

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