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_coord.f90 in branches/UKMO/dev_r5518_Surge_Modelling/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/UKMO/dev_r5518_Surge_Modelling/NEMOGCM/TOOLS/SIREN/src/create_coord.f90 @ 5942

Last change on this file since 5942 was 5942, checked in by rfurner, 8 years ago

merged bug fixes from vn3.6_stable to this branch

File size: 20.5 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5!
6! PROGRAM: create_coord
7!
8! DESCRIPTION:
9!> @file
10!> @brief
11!> This program create fine grid coordinate file.
12!>
13!> @details
14!> @section sec1 method
15!>    All variables from the input coordinates coarse grid file, are extracted
16!>    and interpolated to create fine grid coordinates files.<br/>
17!>    @note
18!>       interpolation method could be different for each variable.
19!>
20!> @section sec2 how to
21!>    to create fine grid coordinates files:<br/>
22!> @code{.sh}
23!>    ./SIREN/bin/create_coord create_coord.nam
24!> @endcode
25!>   
26!> @note
27!>    you could find a template of the namelist in templates directory.
28!>
29!>    create_coord.nam comprise 6 namelists:<br/>
30!>       - logger namelist (namlog)
31!>       - config namelist (namcfg)
32!>       - coarse grid namelist (namcrs)
33!>       - variable namelist (namvar)
34!>       - nesting namelist (namnst)
35!>       - output namelist (namout)
36!>   
37!>    @note
38!>       All namelists have to be in file create_coord.nam,
39!>       however variables of those namelists are all optional.
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!>
51!>    * _coarse grid namelist (namcrs)_:<br/>
52!>       - cn_coord0 : coordinate file
53!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in
54!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
55!>
56!>    * _variable namelist (namvar)_:<br/>
57!>       - cn_varinfo : list of variable and extra information about request(s)
58!> to be used.<br/>
59!>          each elements of *cn_varinfo* is a string character
60!>          (separated by ',').<br/>
61!>          it is composed of the variable name follow by ':',
62!>          then request(s) to be used on this variable.<br/>
63!>          request could be:
64!>             - int = interpolation method
65!>             - ext = extrapolation method
66!>             - flt = filter method
67!>
68!>                requests must be separated by ';' .<br/>
69!>                order of requests does not matter.<br/>
70!>
71!>          informations about available method could be find in @ref interp,
72!>          @ref extrap and @ref filter modules.<br/>
73!>
74!>          Example: 'votemper: int=linear; flt=hann(2,3); ext=dist_weight',
75!>          'vosaline: int=cubic'<br/>
76!>          @note
77!>             If you do not specify a method which is required,
78!>             default one is applied.
79!>
80!>    * _nesting namelist (namnst)_:<br/>
81!>       - in_imin0 : i-direction lower left  point indice
82!> of coarse grid subdomain to be used
83!>       - in_imax0 : i-direction upper right point indice
84!> of coarse grid subdomain to be used
85!>       - in_jmin0 : j-direction lower left  point indice
86!> of coarse grid subdomain to be used
87!>       - in_jmax0 : j-direction upper right point indice
88!> of coarse grid subdomain to be used
89!>       - in_rhoi  : refinement factor in i-direction
90!>       - in_rhoj  : refinement factor in j-direction<br/>
91!>
92!>       \image html  grid_zoom_40.png
93!>       \image latex grid_zoom_40.png
94!>
95!>    * _output namelist (namout)_:
96!>       - cn_fileout : output coordinate file name
97!>
98!> @author J.Paul
99! REVISION HISTORY:
100!> @date November, 2013 - Initial Version
101!> @date September, 2014
102!> - add header for user
103!> - compute offset considering grid point
104!> - add global attributes in output file
105!>
106!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
107!----------------------------------------------------------------------
108PROGRAM create_coord
109
110   USE global                          ! global variable
111   USE kind                            ! F90 kind parameter
112   USE logger                          ! log file manager
113   USE fct                             ! basic useful function
114   USE date                            ! date manager
115   USE att                             ! attribute manager
116   USE dim                             ! dimension manager
117   USE var                             ! variable manager
118   USE file                            ! file manager
119   USE iom                             ! I/O manager
120   USE grid                            ! grid manager
121   USE extrap                          ! extrapolation manager
122   USE interp                          ! interpolation manager
123   USE filter                          ! filter manager
124   USE mpp                             ! MPP manager
125   USE dom                             ! domain manager
126   USE iom_mpp                         ! MPP I/O manager
127   USE iom_dom                         ! DOM I/O manager
128
129   IMPLICIT NONE
130
131   ! local variable
132   CHARACTER(LEN=lc)                                    :: cl_namelist
133   CHARACTER(LEN=lc)                                    :: cl_date
134
135   INTEGER(i4)                                          :: il_narg
136   INTEGER(i4)                                          :: il_status
137   INTEGER(i4)                                          :: il_fileid
138   INTEGER(i4)                                          :: il_attid
139   INTEGER(i4)                                          :: il_ind
140   INTEGER(i4)                                          :: il_nvar
141   INTEGER(i4)                                          :: il_ew
142   INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_rho
143   INTEGER(i4)      , DIMENSION(2,2,ip_npoint)          :: il_offset
144
145   LOGICAL                                              :: ll_exist
146
147   TYPE(TATT)                                           :: tl_att
148
149   TYPE(TDOM)                                           :: tl_dom
150
151   TYPE(TVAR)       , DIMENSION(:)        , ALLOCATABLE :: tl_var
152
153   TYPE(TDIM)       , DIMENSION(ip_maxdim)              :: tl_dim
154
155   TYPE(TMPP)                                           :: tl_coord0
156   TYPE(TFILE)                                          :: tl_fileout
157
158   ! loop indices
159   INTEGER(i4) :: ji
160   INTEGER(i4) :: jj
161
162   ! namelist variable
163   ! namlog
164   CHARACTER(LEN=lc) :: cn_logfile = 'create_coord.log' 
165   CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 
166   INTEGER(i4)       :: in_maxerror = 5
167
168   ! namcfg
169   CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg' 
170
171   ! namcrs
172   CHARACTER(LEN=lc) :: cn_coord0 = '' 
173   INTEGER(i4)       :: in_perio0 = -1
174
175   ! namvar
176   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
177
178   !namnst
179   INTEGER(i4)       :: in_imin0 = 0
180   INTEGER(i4)       :: in_imax0 = 0
181   INTEGER(i4)       :: in_jmin0 = 0
182   INTEGER(i4)       :: in_jmax0 = 0
183   INTEGER(i4)       :: in_rhoi  = 1
184   INTEGER(i4)       :: in_rhoj  = 1
185
186   !namout
187   CHARACTER(LEN=lc) :: cn_fileout= 'coord_fine.nc'
188   !-------------------------------------------------------------------
189
190   NAMELIST /namlog/ &  !  logger namelist
191   &  cn_logfile,    &  !< logger file name
192   &  cn_verbosity,  &  !< logger verbosity
193   &  in_maxerror       !< logger maximum error
194
195   NAMELIST /namcfg/ &  !  config namelist
196   &  cn_varcfg         !< variable configuration file
197
198   NAMELIST /namcrs/ &  !  coarse grid namelist
199   &  cn_coord0 , &     !< coordinate file
200   &  in_perio0         !< periodicity index
201
202   NAMELIST /namvar/ &  !  variable namelist
203   &  cn_varinfo        !< list of variable and extra information about
204                        !< interpolation, extrapolation or filter method to be used.
205                        !< (ex: 'votemper:linear,hann,dist_weight','vosaline:cubic' )
206   
207   NAMELIST /namnst/ &  !  nesting namelist
208   &  in_imin0,   &     !< i-direction lower left  point indice
209   &  in_imax0,   &     !< i-direction upper right point indice
210   &  in_jmin0,   &     !< j-direction lower left  point indice
211   &  in_jmax0,   &     !< j-direction upper right point indice
212   &  in_rhoi,    &     !< refinement factor in i-direction
213   &  in_rhoj           !< refinement factor in j-direction
214
215   NAMELIST /namout/ &  !  output namelist
216   &  cn_fileout        !< fine grid coordinate file   
217   !-------------------------------------------------------------------
218
219   ! namelist
220   ! get namelist
221   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
222   IF( il_narg/=1 )THEN
223      PRINT *,"ERROR in create_coord: need a namelist"
224      STOP
225   ELSE
226      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
227   ENDIF
228   
229   ! read namelist
230   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
231   IF( ll_exist )THEN
232 
233      il_fileid=fct_getunit()
234
235      OPEN( il_fileid, FILE=TRIM(cl_namelist),   &
236      &                FORM='FORMATTED',         &
237      &                ACCESS='SEQUENTIAL',      &
238      &                STATUS='OLD',             &
239      &                ACTION='READ',            &
240      &                IOSTAT=il_status)
241      CALL fct_err(il_status)
242      IF( il_status /= 0 )THEN
243         PRINT *,"ERROR in create_coord: error opening "//TRIM(cl_namelist)
244         STOP
245      ENDIF
246
247      READ( il_fileid, NML = namlog )
248      ! define logger file
249      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
250      CALL logger_header()
251
252      READ( il_fileid, NML = namcfg )
253      ! get variable extra information on configuration file
254      CALL var_def_extra(TRIM(cn_varcfg))
255
256      READ( il_fileid, NML = namcrs )
257      READ( il_fileid, NML = namvar )
258      ! add user change in extra information
259      CALL var_chg_extra( cn_varinfo )
260
261      READ( il_fileid, NML = namnst )
262      READ( il_fileid, NML = namout )
263
264      CLOSE( il_fileid, IOSTAT=il_status )
265      CALL fct_err(il_status)
266      IF( il_status /= 0 )THEN
267         CALL logger_error("CREATE COORD: closing "//TRIM(cl_namelist))
268      ENDIF
269
270   ELSE
271
272      PRINT *,"ERROR in create_coord: can't find "//TRIM(cl_namelist)
273      STOP
274
275   ENDIF
276
277   ! open files
278   IF( cn_coord0 /= '' )THEN
279      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
280      CALL grid_get_info(tl_coord0)
281   ELSE
282      CALL logger_fatal("CREATE COORD: no coarse grid coordinate found. "//&
283      &     "check namelist")     
284   ENDIF
285
286   ! check
287   ! check output file do not already exist
288   INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist)
289   IF( ll_exist )THEN
290      CALL logger_fatal("CREATE COORD: output file "//TRIM(cn_fileout)//&
291      &  " already exist.")
292   ENDIF
293
294   ! check nesting parameters
295   IF( in_imin0 < 0 .OR. in_imax0 < 0 .OR. in_jmin0 < 0 .OR. in_jmax0 < 0)THEN
296      CALL logger_fatal("CREATE COORD: invalid points indices."//&
297      &  " check namelist "//TRIM(cl_namelist))
298   ENDIF
299
300   il_rho(:)=1
301   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
302      CALL logger_error("CREATE COORD: invalid refinement factor."//&
303      &  " check namelist "//TRIM(cl_namelist))
304   ELSE
305      il_rho(jp_I)=in_rhoi
306      il_rho(jp_J)=in_rhoj     
307
308      il_offset(:,:,:)=create_coord_get_offset(il_rho(:))
309   ENDIF
310
311   ! check domain validity
312   CALL grid_check_dom(tl_coord0, in_imin0, in_imax0, in_jmin0, in_jmax0 )
313
314   ! compute domain
315   tl_dom=dom_init( tl_coord0,         &
316   &                in_imin0, in_imax0,&
317   &                in_jmin0, in_jmax0 )
318
319   ! add extra band (if need be) to compute interpolation
320   CALL dom_add_extra(tl_dom)
321
322   ! open mpp files
323   CALL iom_dom_open(tl_coord0, tl_dom)
324
325   il_nvar=tl_coord0%t_proc(1)%i_nvar
326   ALLOCATE( tl_var(il_nvar) )
327   DO ji=1,il_nvar
328
329      tl_var(ji)=iom_dom_read_var(tl_coord0, &
330      &                          TRIM(tl_coord0%t_proc(1)%t_var(ji)%c_name),&
331      &                          tl_dom)
332
333      SELECT CASE(TRIM(tl_var(ji)%c_point))
334         CASE('T')
335            jj=jp_T
336         CASE('U')
337            jj=jp_U
338         CASE('V')
339            jj=jp_V
340         CASE('F')
341            jj=jp_F
342      END SELECT
343
344      ! interpolate variables
345      CALL create_coord_interp( tl_var(ji), il_rho(:), &
346      &                         il_offset(:,:,jj) )
347
348      ! remove extraband added to domain
349      CALL dom_del_extra( tl_var(ji), tl_dom, il_rho(:), .true. )
350
351      ! filter
352      CALL filter_fill_value(tl_var(ji))     
353
354   ENDDO
355
356   ! close mpp files
357   CALL iom_dom_close(tl_coord0)
358
359   ! clean
360   CALL mpp_clean(tl_coord0)
361
362   ! create file
363   tl_fileout=file_init(TRIM(cn_fileout))
364
365   ! add dimension
366   ! save biggest dimension
367   tl_dim(:)=var_max_dim(tl_var(:))
368
369   DO ji=1,ip_maxdim
370      IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
371   ENDDO
372
373   ! add variables
374   DO ji=il_nvar,1,-1
375      CALL file_add_var(tl_fileout, tl_var(ji))
376      CALL var_clean(tl_var(ji))
377   ENDDO
378
379   ! add some attribute
380   tl_att=att_init("Created_by","SIREN create_coord")
381   CALL file_add_att(tl_fileout, tl_att)
382
383   cl_date=date_print(date_now())
384   tl_att=att_init("Creation_date",cl_date)
385   CALL file_add_att(tl_fileout, tl_att)
386
387   tl_att=att_init("src_file",TRIM(fct_basename(cn_coord0)))
388   CALL file_add_att(tl_fileout, tl_att)   
389
390   tl_att=att_init("src_i_indices",(/in_imin0,in_imax0/))
391   CALL file_add_att(tl_fileout, tl_att)   
392   tl_att=att_init("src_j_indices",(/in_jmin0,in_jmax0/))
393   CALL file_add_att(tl_fileout, tl_att)
394   IF( .NOT. ALL(il_rho(:)==1) )THEN
395      tl_att=att_init("refinment_factor",(/il_rho(jp_I),il_rho(jp_J)/))
396      CALL file_add_att(tl_fileout, tl_att)
397   ENDIF
398
399   ! add attribute periodicity
400   il_attid=0
401   IF( ASSOCIATED(tl_fileout%t_att) )THEN
402      il_attid=att_get_index(tl_fileout%t_att(:),'periodicity')
403   ENDIF
404   IF( tl_dom%i_perio >= 0 .AND. il_attid == 0 )THEN
405      tl_att=att_init('periodicity',tl_dom%i_perio)
406      CALL file_add_att(tl_fileout,tl_att)
407   ENDIF
408
409   ! add attribute east west overlap
410   il_attid=0
411   IF( ASSOCIATED(tl_fileout%t_att) )THEN
412      il_attid=att_get_index(tl_fileout%t_att(:),'ew_overlap')
413   ENDIF
414   IF( il_attid == 0 )THEN
415      il_ind=var_get_index(tl_fileout%t_var(:),'longitude')
416      il_ew=grid_get_ew_overlap(tl_fileout%t_var(il_ind))
417      IF( il_ew >= 0 )THEN
418         tl_att=att_init('ew_overlap',il_ew)
419         CALL file_add_att(tl_fileout,tl_att)
420      ENDIF
421   ENDIF
422
423   ! create file
424   CALL iom_create(tl_fileout)
425
426   ! write file
427   CALL iom_write_file(tl_fileout)
428
429   ! close file
430   CALL iom_close(tl_fileout)
431
432   ! clean
433   CALL att_clean(tl_att)
434   CALL var_clean(tl_var(:))
435   DEALLOCATE( tl_var) 
436
437   CALL file_clean(tl_fileout)
438
439   ! close log file
440   CALL logger_footer()
441   CALL logger_close() 
442
443CONTAINS
444   !-------------------------------------------------------------------
445   !> @brief
446   !> This function compute offset over Arakawa grid points,
447   !> given refinement factor.
448   !>
449   !> @author J.Paul
450   !> @date August, 2014 - Initial Version
451   !>
452   !> @param[in] id_rho array of refinement factor
453   !> @return array of offset
454   !-------------------------------------------------------------------
455   FUNCTION create_coord_get_offset( id_rho )
456      IMPLICIT NONE
457      ! Argument     
458      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_rho
459
460      ! function
461      INTEGER(i4), DIMENSION(2,2,ip_npoint) :: create_coord_get_offset
462      ! local variable
463      ! loop indices
464      !----------------------------------------------------------------
465
466      ! case 'T'
467      create_coord_get_offset(jp_I,:,jp_T)=FLOOR(REAL(id_rho(jp_I)-1,dp)*0.5)
468      create_coord_get_offset(jp_J,:,jp_T)=FLOOR(REAL(id_rho(jp_J)-1,dp)*0.5)
469      ! case 'U'
470      create_coord_get_offset(jp_I,1,jp_U)=0
471      create_coord_get_offset(jp_I,2,jp_U)=id_rho(jp_I)-1
472      create_coord_get_offset(jp_J,:,jp_U)=FLOOR(REAL(id_rho(jp_J)-1,dp)*0.5)
473      ! case 'V'
474      create_coord_get_offset(jp_I,:,jp_V)=FLOOR(REAL(id_rho(jp_I)-1,dp)*0.5)
475      create_coord_get_offset(jp_J,1,jp_V)=0
476      create_coord_get_offset(jp_J,2,jp_V)=id_rho(jp_J)-1
477      ! case 'F'
478      create_coord_get_offset(jp_I,1,jp_F)=0
479      create_coord_get_offset(jp_I,2,jp_F)=id_rho(jp_I)-1
480      create_coord_get_offset(jp_J,1,jp_F)=0
481      create_coord_get_offset(jp_J,2,jp_F)=id_rho(jp_J)-1
482
483
484   END FUNCTION create_coord_get_offset
485   !-------------------------------------------------------------------
486   !> @brief
487   !> This subroutine interpolate variable, given refinment factor.
488   !>
489   !> @details
490   !>  Optionaly, you could specify number of points
491   !>    to be extrapolated in i- and j-direction.<br/>
492   !>  variable mask is first computed (using _FillValue) and interpolated.<br/>
493   !>  variable is then extrapolated, and interpolated.<br/>
494   !>  Finally interpolated mask is applied on refined variable.
495   !>
496   !> @author J.Paul
497   !> @date November, 2013 - Initial Version
498   !>
499   !> @param[inout] td_var variable strcuture
500   !> @param[in] id_rho    array of refinement factor
501   !> @param[in] id_offset offset between fine grid and coarse grid
502   !> @param[in] id_iext   number of points to be extrapolated in i-direction
503   !> @param[in] id_jext   number of points to be extrapolated in j-direction
504   !>
505   !> @todo check if mask is really needed
506   !-------------------------------------------------------------------
507   SUBROUTINE create_coord_interp( td_var,          &
508   &                               id_rho,          &
509   &                               id_offset,       &
510   &                               id_iext, id_jext)
511
512      IMPLICIT NONE
513
514      ! Argument
515      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
516      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
517      INTEGER(i4), DIMENSION(:,:), INTENT(IN)    :: id_offset
518      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
519      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
520
521      ! local variable
522      TYPE(TVAR)  :: tl_mask
523
524      INTEGER(i1), DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
525
526      INTEGER(i4) :: il_iext
527      INTEGER(i4) :: il_jext
528
529      ! loop indices
530      !----------------------------------------------------------------
531
532      IF( ANY(SHAPE(id_offset(:,:)) /= 2) )THEN
533         CALL logger_error("CREATE COORD INTERP: invalid dimension of "//&
534         &                 "offset array")
535      ENDIF
536
537      !WARNING: two extrabands are required for cubic interpolation
538      il_iext=2
539      IF( PRESENT(id_iext) ) il_iext=id_iext
540
541      il_jext=2
542      IF( PRESENT(id_jext) ) il_jext=id_jext
543     
544      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
545         CALL logger_warn("CREATE COORD INTERP: at least extrapolation "//&
546         &  "on two points are required with cubic interpolation ")
547         il_iext=2
548      ENDIF
549
550      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
551         CALL logger_warn("CREATE COORD INTERP: at least extrapolation "//&
552         &  "on two points are required with cubic interpolation ")
553         il_jext=2
554      ENDIF
555
556      IF( ANY(id_rho(:)>1) )THEN
557         ! work on mask
558         ! create mask
559         ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
560         &                td_var%t_dim(2)%i_len, &
561         &                td_var%t_dim(3)%i_len, &
562         &                td_var%t_dim(4)%i_len) )
563
564         bl_mask(:,:,:,:)=1
565         WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0     
566
567         SELECT CASE(TRIM(td_var%c_point))
568         CASE DEFAULT ! 'T'
569            tl_mask=var_init('tmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
570            &                id_ew=td_var%i_ew )
571         CASE('U')
572            tl_mask=var_init('umask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
573            &                id_ew=td_var%i_ew )
574         CASE('V')
575            tl_mask=var_init('vmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
576            &                id_ew=td_var%i_ew )
577         CASE('F')
578            tl_mask=var_init('fmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
579            &                id_ew=td_var%i_ew )
580         END SELECT         
581
582         DEALLOCATE(bl_mask)
583
584         ! interpolate mask
585         CALL interp_fill_value( tl_mask, id_rho(:), &
586         &                       id_offset=id_offset(:,:) )
587
588         ! work on variable
589         ! add extraband
590         CALL extrap_add_extrabands(td_var, il_iext, il_jext)
591
592         ! extrapolate variable
593         CALL extrap_fill_value( td_var )
594
595         ! interpolate variable
596         CALL interp_fill_value( td_var, id_rho(:), &
597         &                       id_offset=id_offset(:,:))
598
599         ! remove extraband
600         CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
601
602         ! keep original mask
603         WHERE( tl_mask%d_value(:,:,:,:) == 0 )
604            td_var%d_value(:,:,:,:)=td_var%d_fill
605         END WHERE
606      ENDIF
607
608      ! clean variable structure
609      CALL var_clean(tl_mask)
610
611   END SUBROUTINE create_coord_interp
612END PROGRAM create_coord
Note: See TracBrowser for help on using the repository browser.