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/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src/create_restart.f90 @ 4213

Last change on this file since 4213 was 4213, checked in by cbricaud, 10 years ago

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