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

source: branches/2016/dev_INGV_UKMO_2016/NEMOGCM/TOOLS/SIREN/src/create_coord.f90 @ 7351

Last change on this file since 7351 was 7351, checked in by emanuelaclementi, 7 years ago

ticket #1805 step 3: /2016/dev_INGV_UKMO_2016 aligned to the trunk at revision 7161

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