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/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/create_restart.f90 @ 7235

Last change on this file since 7235 was 7235, checked in by jpaul, 7 years ago

see ticket #1781

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