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_boundary.F90 in branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/create_boundary.F90 @ 7153

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

see ticket #1781

File size: 62.6 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5!
6! PROGRAM: create_boundary
7!
8! DESCRIPTION:
9!> @file
10!> @brief
11!> This program creates boundary files.
12!>
13!> @details
14!> @section sec1 method
15!> Variables are read from coarse grid standard output,
16!> extracted or interpolated on fine grid.
17!> Variables could also be manually written.<br/>
18!> @note
19!>    method could be different for each variable.
20!>
21!> @section sec2 how to
22!>    to create boundaries files:<br/>
23!> @code{.sh}
24!>    ./SIREN/bin/create_boundary create_boundary.nam
25!> @endcode
26!>  <br/>
27!> \image html  boundary_NEATL36_70.png
28!> <center>\image latex boundary_NEATL36_70.png
29!> </center>
30!>
31!> @note
32!>    you could find a template of the namelist in templates directory.
33!>
34!>    create_boundary.nam contains 9 namelists:<br/>
35!>       - logger namelist (namlog)
36!>       - config namelist (namcfg)
37!>       - coarse grid namelist (namcrs)
38!>       - fine grid namelist (namfin)
39!>       - variable namelist (namvar)
40!>       - nesting namelist (namnst)
41!>       - boundary namelist (nambdy)
42!>       - vertical grid namelist (namzgr)
43!>       - output namelist (namout)
44!>   
45!>    * _logger namelist (namlog)_:<br/>
46!>       - cn_logfile   : log filename
47!>       - cn_verbosity : verbosity ('trace','debug','info',
48!> 'warning','error','fatal','none')
49!>       - in_maxerror  : maximum number of error allowed
50!>
51!>    * _config namelist (namcfg)_:<br/>
52!>       - cn_varcfg : variable configuration file
53!> (see ./SIREN/cfg/variable.cfg)
54!>       - cn_dimcfg : dimension configuration file. define dimension allowed to
55!> be used (see ./SIREN/cfg/dimension.cfg).
56!>       - cn_dumcfg : useless (dummy) configuration file, for useless
57!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
58!>
59!>    * _coarse grid namelist (namcrs)_:<br/>
60!>       - cn_coord0 : coordinate file
61!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in
62!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
63!>
64!>    * _fine grid namelist (namfin)_:<br/>
65!>       - cn_coord1 : coordinate file
66!>       - cn_bathy1 : bathymetry file
67!>       - in_perio1 : periodicity index
68!>
69!>    * _vertical grid namelist (namzgr)_:<br/>
70!>       - dn_ppsur              :
71!>       - dn_ppa0               :
72!>       - dn_ppa1               :
73!>       - dn_ppa2               :
74!>       - dn_ppkth              :
75!>       - dn_ppkth2             :
76!>       - dn_ppacr              :
77!>       - dn_ppacr2             :
78!>       - dn_ppdzmin            :
79!>       - dn_pphmax             :
80!>       - in_nlevel             : number of vertical level
81!>
82!>    * _partial step namelist (namzps)_:<br/>
83!>       - dn_e3zps_min          :
84!>       - dn_e3zps_rat          :
85!>
86!>    * _variable namelist (namvar)_:<br/>
87!>       - cn_varfile : list of variable, and associated file<br/>
88!>          *cn_varfile* is the path and filename of the file where find
89!>          variable.<br/>
90!>          @note
91!>             *cn_varfile* could be a matrix of value, if you want to filled
92!>             manually variable value.<br/>
93!>             the variable array of value is split into equal subdomain.<br/>
94!>             Each subdomain is filled with the corresponding value
95!>             of the matrix.<br/>         
96!>             separators used to defined matrix are:
97!>                - ',' for line
98!>                - '/' for row
99!>                - '\' for level<br/>
100!>                Example:<br/>
101!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
102!>                                         3 & 2 & 3 \\\\
103!>                                         1 & 4 & 5 \end{array} \right) @f$
104!>          @warning
105!>             the same matrix is used for all boundaries.
106!>
107!>       Examples:
108!>          - 'votemper:gridT.nc', 'vozocrtx:gridU.nc'
109!>          - 'votemper:10\25', 'vozocrtx:gridU.nc'
110!>
111!>       - cn_varinfo : list of variable and extra information about request(s)
112!>          to be used (separated by ',').<br/>
113!>          each elements of *cn_varinfo* is a string character.<br/>
114!>          it is composed of the variable name follow by ':',
115!>          then request(s) to be used on this variable.<br/>
116!>          request could be:
117!>             - int = interpolation method
118!>             - ext = extrapolation method
119!>             - flt = filter method
120!>             - min = minimum value
121!>             - max = maximum value
122!>             - unt = new units
123!>             - unf = unit scale factor (linked to new units)
124!>
125!>                requests must be separated by ';'.<br/>
126!>                order of requests does not matter.
127!>
128!>          informations about available method could be find in @ref interp,
129!>          @ref extrap and @ref filter.<br/>
130!>
131!>          Example: 'votemper:int=linear;flt=hann;ext=dist_weight',
132!>                   'vosaline:int=cubic'
133!>          @note
134!>             If you do not specify a method which is required,
135!>             default one is apply.
136!>
137!>    * _nesting namelist (namnst)_:<br/>
138!>       - in_rhoi  : refinement factor in i-direction
139!>       - in_rhoj  : refinement factor in j-direction
140!>
141!>    * _boundary namelist (nambdy)_:<br/>
142!>       - ln_north  : use north boundary
143!>       - ln_south  : use south boundary
144!>       - ln_east   : use east  boundary
145!>       - ln_west   : use west  boundary
146!>       - cn_north  : north boundary indices on fine grid
147!>          *cn_north* is a string character defining boundary
148!>          segmentation.<br/>
149!>          segments are separated by '|'.<br/>
150!>          each segments of the boundary is composed of:
151!>             - indice of velocity (orthogonal to boundary .ie.
152!>                for north boundary, J-indice).
153!>             - indice of segment start (I-indice for north boundary)
154!>             - indice of segment end   (I-indice for north boundary)<br/>
155!>                indices must be separated by ':' .<br/>
156!>             - optionally, boundary size could be added between '(' and ')'
157!>             in the definition of the first segment.
158!>                @note
159!>                   boundary width is the same for all segments of one boundary.
160!>
161!>          Examples:
162!>             - cn_north='index1,first1:last1(width)'
163!>             - cn_north='index1(width),first1:last1|index2,first2:last2'
164!>             \image html  boundary_50.png
165!>             <center>\image latex boundary_50.png
166!>             </center>
167!>       - cn_south  : south boundary indices on fine grid
168!>       - cn_east   : east  boundary indices on fine grid
169!>       - cn_west   : west  boundary indices on fine grid
170!>       - ln_oneseg : force to use only one segment for each boundary or not
171!>
172!>    * _output namelist (namout)_:<br/>
173!>       - cn_fileout : fine grid boundary basename
174!>         (cardinal point and segment number will be automatically added)
175!>       - dn_dayofs  : date offset in day (change only ouput file name)
176!>       - ln_extrap  : extrapolate land point or not
177!>
178!>          Examples:
179!>             - cn_fileout='boundary.nc'<br/>
180!>                if time_counter (16/07/2015 00h) is read on input file (see varfile),
181!>                west boundary will be named boundary_west_y2015m07d16
182!>             - dn_dayofs=-2.<br/>
183!>                if you use day offset you get boundary_west_y2015m07d14
184!>       
185!>
186!> @author J.Paul
187! REVISION HISTORY:
188!> @date November, 2013 - Initial Version
189!> @date September, 2014
190!> - add header for user
191!> - take into account grid point to compue boundaries
192!> - reorder output dimension for north and south boundaries
193!> @date June, 2015
194!> - extrapolate all land points, and add ln_extrap in namelist.
195!> - allow to change unit.
196!> @date July, 2015
197!> - add namelist parameter to shift date of output file name.
198!> @date September, 2015
199!> - manage useless (dummy) variable, attributes, and dimension
200!> - allow to run on multi processors with key_mpp_mpi
201!> @date January, 2016
202!> - same process use for variable extracted or interpolated from input file.
203!> @date October, 2016
204!> - dimension to be used select from configuration file
205!>
206!> @todo
207!> - rewitre using meshmask instead of bathymetry and coordinates files.
208!>
209!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
210!----------------------------------------------------------------------
211PROGRAM create_boundary
212
213   USE netcdf                          ! nf90 library
214   USE global                          ! global variable
215   USE phycst                          ! physical constant
216   USE kind                            ! F90 kind parameter
217   USE fct                             ! basic useful function
218   USE date                            ! date manager
219   USE att                             ! attribute manager
220   USE dim                             ! dimension manager
221   USE var                             ! variable manager
222   USE file                            ! file manager
223   USE multi                           ! multi file manager
224   USE boundary                        ! boundary manager
225   USE iom                             ! I/O manager
226   USE dom                             ! domain manager
227   USE grid                            ! grid manager
228   USE vgrid                           ! vertical grid manager
229   USE extrap                          ! extrapolation manager
230   USE interp                          ! interpolation manager
231   USE filter                          ! filter manager
232   USE mpp                             ! MPP manager
233   USE iom_mpp                         ! MPP I/O manager
234
235   IMPLICIT NONE
236
237   ! local variable
238   INTEGER(i4)                                        :: il_narg
239
240#if defined key_mpp_mpi
241   ! mpp variable
242   CHARACTER(LEN=lc), DIMENSION(:)      , ALLOCATABLE :: cl_namelist
243   INTEGER(i4)                                        :: ierror
244   INTEGER(i4)                                        :: iproc
245   INTEGER(i4)                                        :: nproc
246   INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_nprog
247
248   ! loop indices
249   INTEGER(i4) :: jm
250#else
251   CHARACTER(LEN=lc)                                  :: cl_namelist
252#endif
253   !-------------------------------------------------------------------
254#if defined key_mpp_mpi
255   INCLUDE 'mpif.h'
256#endif
257   !-------------------------------------------------------------------
258
259   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
260#if ! defined key_mpp_mpi
261
262   IF( il_narg/=1 )THEN
263      PRINT *,"CREATE BOUNDARY: ERROR. need one namelist"
264      STOP
265   ELSE
266      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
267   ENDIF
268
269   CALL create__boundary(cl_namelist)
270
271#else
272
273   ! Initialize MPI
274   CALL mpi_init(ierror)
275   CALL mpi_comm_rank(mpi_comm_world,iproc,ierror)
276   CALL mpi_comm_size(mpi_comm_world,nproc,ierror)
277
278   IF( il_narg==0 )THEN
279      PRINT *,"CREATE BOUNDARY: ERROR. need at least one namelist"
280      STOP
281   ELSE
282      ALLOCATE(cl_namelist(il_narg))
283      DO jm=1,il_narg
284         CALL GET_COMMAND_ARGUMENT(jm,cl_namelist(jm))
285      ENDDO
286   ENDIF
287
288   ALLOCATE(il_nprog(il_narg))
289   DO jm=1, il_narg
290      il_nprog(jm)= MOD(jm,nproc)
291   ENDDO
292
293   DO jm=1, il_narg
294      IF ( il_nprog(jm) .eq. iproc ) THEN
295         CALL create__boundary(cl_namelist(jm))
296      ENDIF
297   ENDDO
298
299   CALL mpi_finalize(ierror)
300
301   DEALLOCATE(cl_namelist)
302   DEALLOCATE(il_nprog)
303#endif
304
305CONTAINS
306SUBROUTINE create__boundary(cd_namelist)
307   !-------------------------------------------------------------------
308   !> @brief
309   !> This subroutine create boundary files.
310   !>
311   !> @details
312   !>
313   !> @author J.Paul
314   !> @date January, 2016 - Initial Version
315   !>
316   !> @param[in] cd_namelist namelist file
317   !-------------------------------------------------------------------
318
319   USE logger                          ! log file manager
320
321   IMPLICIT NONE
322   ! Argument
323   CHARACTER(LEN=lc), INTENT(IN) :: cd_namelist 
324
325   ! local variable
326   CHARACTER(LEN=lc)                                  :: cl_date
327   CHARACTER(LEN=lc)                                  :: cl_name
328   CHARACTER(LEN=lc)                                  :: cl_bdyout
329   CHARACTER(LEN=lc)                                  :: cl_data
330   CHARACTER(LEN=lc)                                  :: cl_dimorder
331   CHARACTER(LEN=lc)                                  :: cl_fmt
332
333   INTEGER(i4)                                        :: il_status
334   INTEGER(i4)                                        :: il_fileid
335   INTEGER(i4)                                        :: il_imin0
336   INTEGER(i4)                                        :: il_imax0
337   INTEGER(i4)                                        :: il_jmin0
338   INTEGER(i4)                                        :: il_jmax0
339   INTEGER(i4)                                        :: il_shift
340   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
341   INTEGER(i4)      , DIMENSION(2,2)                  :: il_offset
342   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
343
344   LOGICAL                                            :: ll_exist
345
346   TYPE(TATT)                                         :: tl_att
347   
348   TYPE(TVAR)                                         :: tl_depth   
349   TYPE(TVAR)                                         :: tl_time
350   TYPE(TVAR)                                         :: tl_var1
351   TYPE(TVAR)                                         :: tl_var0
352   TYPE(TVAR)                                         :: tl_lon1
353   TYPE(TVAR)                                         :: tl_lat1
354   TYPE(TVAR)                                         :: tl_lvl1 
355   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_level
356   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_seglvl1
357   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segvar1
358
359   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
360
361   TYPE(TDATE)                                        :: tl_date
362   
363   TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy
364   
365   TYPE(TDOM)                                         :: tl_dom0
366   TYPE(TDOM)                                         :: tl_dom1
367   TYPE(TDOM)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segdom1
368
369   TYPE(TFILE)                                        :: tl_fileout
370   
371   TYPE(TMPP)                                         :: tl_coord0
372   TYPE(TMPP)                                         :: tl_coord1
373   TYPE(TMPP)                                         :: tl_bathy1
374   TYPE(TMPP)                                         :: tl_mpp
375
376   TYPE(TMULTI)                                       :: tl_multi
377
378   ! loop indices
379   INTEGER(i4) :: jvar
380   INTEGER(i4) :: jpoint
381   INTEGER(i4) :: ji
382   INTEGER(i4) :: jj
383   INTEGER(i4) :: jk
384   INTEGER(i4) :: jl
385
386   ! namelist variable
387   ! namlog
388   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_boundary.log' 
389   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
390   INTEGER(i4)                             :: in_maxerror = 5
391
392   ! namcfg
393   CHARACTER(LEN=lc)                       :: cn_varcfg = './cfg/variable.cfg' 
394   CHARACTER(LEN=lc)                       :: cn_dimcfg = './cfg/dimension.cfg'
395   CHARACTER(LEN=lc)                       :: cn_dumcfg = './cfg/dummy.cfg'
396
397   ! namcrs
398   CHARACTER(LEN=lc)                       :: cn_coord0 = '' 
399   INTEGER(i4)                             :: in_perio0 = -1
400
401   ! namfin
402   CHARACTER(LEN=lc)                       :: cn_coord1 = '' 
403   CHARACTER(LEN=lc)                       :: cn_bathy1 = '' 
404   INTEGER(i4)                             :: in_perio1 = -1
405
406   !namzgr
407   REAL(dp)                                :: dn_ppsur   = -3958.951371276829_dp
408   REAL(dp)                                :: dn_ppa0    =   103.953009600000_dp
409   REAL(dp)                                :: dn_ppa1    =     2.415951269000_dp
410   REAL(dp)                                :: dn_ppa2    =   100.760928500000_dp
411   REAL(dp)                                :: dn_ppkth   =    15.351013700000_dp
412   REAL(dp)                                :: dn_ppkth2  =    48.029893720000_dp
413   REAL(dp)                                :: dn_ppacr   =     7.000000000000_dp
414   REAL(dp)                                :: dn_ppacr2  =    13.000000000000_dp
415   REAL(dp)                                :: dn_ppdzmin = 6._dp
416   REAL(dp)                                :: dn_pphmax  = 5750._dp
417   INTEGER(i4)                             :: in_nlevel  = 75
418
419   !namzps
420   REAL(dp)                                :: dn_e3zps_min = 25._dp
421   REAL(dp)                                :: dn_e3zps_rat = 0.2_dp
422
423   ! namvar
424   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
425   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
426
427   ! namnst
428   INTEGER(i4)                             :: in_rhoi  = 0
429   INTEGER(i4)                             :: in_rhoj  = 0
430
431   ! nambdy
432   LOGICAL                                 :: ln_north   = .TRUE.
433   LOGICAL                                 :: ln_south   = .TRUE.
434   LOGICAL                                 :: ln_east    = .TRUE.
435   LOGICAL                                 :: ln_west    = .TRUE.
436   LOGICAL                                 :: ln_oneseg  = .TRUE.
437   CHARACTER(LEN=lc)                       :: cn_north   = ''
438   CHARACTER(LEN=lc)                       :: cn_south   = ''
439   CHARACTER(LEN=lc)                       :: cn_east    = ''
440   CHARACTER(LEN=lc)                       :: cn_west    = ''
441
442   ! namout
443   CHARACTER(LEN=lc)                       :: cn_fileout = 'boundary.nc' 
444   REAL(dp)                                :: dn_dayofs  = 0._dp
445   LOGICAL                                 :: ln_extrap  = .FALSE.
446   !-------------------------------------------------------------------
447
448   NAMELIST /namlog/ &  !< logger namelist
449   &  cn_logfile,    &  !< log file
450   &  cn_verbosity,  &  !< log verbosity
451   &  in_maxerror
452
453   NAMELIST /namcfg/ &  !< config namelist
454   &  cn_varcfg, &       !< variable configuration file
455   &  cn_dimcfg, &       !< dimension configuration file
456   &  cn_dumcfg          !< dummy configuration file
457
458   NAMELIST /namcrs/ &  !< coarse grid namelist
459   &  cn_coord0,     &  !< coordinate file
460   &  in_perio0         !< periodicity index
461 
462   NAMELIST /namfin/ &  !< fine grid namelist
463   &  cn_coord1,     &  !< coordinate file
464   &  cn_bathy1,     &  !< bathymetry file
465   &  in_perio1         !< periodicity index
466 
467   NAMELIST /namzgr/ &
468   &  dn_ppsur,     &
469   &  dn_ppa0,      &
470   &  dn_ppa1,      &
471   &  dn_ppa2,      &
472   &  dn_ppkth,     &
473   &  dn_ppkth2,    &
474   &  dn_ppacr,     &
475   &  dn_ppacr2,    &
476   &  dn_ppdzmin,   &
477   &  dn_pphmax,    &
478   &  in_nlevel         !< number of vertical level
479
480   NAMELIST /namzps/ &
481   &  dn_e3zps_min, &
482   &  dn_e3zps_rat
483
484   NAMELIST /namvar/ &  !< variable namelist
485   &  cn_varfile, &     !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' )
486   &  cn_varinfo        !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' )
487 
488   NAMELIST /namnst/ &  !< nesting namelist
489   &  in_rhoi,       &  !< refinement factor in i-direction
490   &  in_rhoj           !< refinement factor in j-direction
491
492   NAMELIST /nambdy/ &  !< boundary namelist
493   &  ln_north,      &  !< use north boundary
494   &  ln_south,      &  !< use south boundary
495   &  ln_east ,      &  !< use east  boundary
496   &  ln_west ,      &  !< use west  boundary
497   &  cn_north,      &  !< north boundary indices on fine grid
498   &  cn_south,      &  !< south boundary indices on fine grid
499   &  cn_east ,      &  !< east  boundary indices on fine grid
500   &  cn_west ,      &  !< west  boundary indices on fine grid
501   &  ln_oneseg         !< use only one segment for each boundary or not
502
503   NAMELIST /namout/ &  !< output namelist
504   &  cn_fileout,    &  !< fine grid boundary file basename   
505   &  dn_dayofs,     &  !< date offset in day (change only ouput file name)
506   &  ln_extrap         !< extrapolate or not
507   !-------------------------------------------------------------------
508
509   ! read namelist
510   INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist)
511
512   IF( ll_exist )THEN
513     
514      il_fileid=fct_getunit()
515
516      OPEN( il_fileid, FILE=TRIM(cd_namelist), &
517      &                FORM='FORMATTED',       &
518      &                ACCESS='SEQUENTIAL',    &
519      &                STATUS='OLD',           &
520      &                ACTION='READ',          &
521      &                IOSTAT=il_status)
522      CALL fct_err(il_status)
523      IF( il_status /= 0 )THEN
524         PRINT *,"CREATE BOUNDARY: ERROR opening "//TRIM(cd_namelist)
525         STOP
526      ENDIF
527
528      READ( il_fileid, NML = namlog )
529      ! define log file
530      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
531      CALL logger_header()
532
533      READ( il_fileid, NML = namcfg )
534      ! get variable extra information
535      CALL var_def_extra(TRIM(cn_varcfg))
536
537      ! get dimension allowed
538      CALL dim_def_extra(TRIM(cn_dimcfg))
539
540      ! get dummy variable
541      CALL var_get_dummy(TRIM(cn_dumcfg))
542      ! get dummy dimension
543      CALL dim_get_dummy(TRIM(cn_dumcfg))
544      ! get dummy attribute
545      CALL att_get_dummy(TRIM(cn_dumcfg))
546
547      READ( il_fileid, NML = namcrs )
548      READ( il_fileid, NML = namfin )
549      READ( il_fileid, NML = namzgr )
550      READ( il_fileid, NML = namvar )
551      ! add user change in extra information
552      CALL var_chg_extra(cn_varinfo)
553      ! match variable with file
554      tl_multi=multi_init(cn_varfile)
555
556      READ( il_fileid, NML = namnst )
557      READ( il_fileid, NML = nambdy )
558      READ( il_fileid, NML = namout )
559
560      CLOSE( il_fileid, IOSTAT=il_status )
561      CALL fct_err(il_status)
562      IF( il_status /= 0 )THEN
563         CALL logger_error("CREATE BOUNDARY: ERROR closing "//TRIM(cd_namelist))
564      ENDIF
565
566   ELSE
567
568      PRINT *,"CREATE BOUNDARY: ERROR. can not find "//TRIM(cd_namelist)
569      STOP
570
571   ENDIF
572
573   CALL multi_print(tl_multi)
574   IF( tl_multi%i_nvar <= 0 )THEN
575      CALL logger_fatal("CREATE BOUNDARY: no variable to be used."//&
576      &  " check namelist.")
577   ENDIF
578
579   ! open files
580   IF( TRIM(cn_coord0) /= '' )THEN
581      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
582      CALL grid_get_info(tl_coord0)
583   ELSE
584      CALL logger_fatal("CREATE BOUNDARY: can not find coarse grid "//&
585      &  "coordinate file. check namelist")
586   ENDIF
587
588   IF( TRIM(cn_coord1) /= '' )THEN
589      tl_coord1=mpp_init( file_init(TRIM(cn_coord1)), id_perio=in_perio1)
590      CALL grid_get_info(tl_coord1)
591   ELSE
592      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid coordinate "//&
593      &  "file. check namelist")
594   ENDIF
595
596   IF( TRIM(cn_bathy1) /= '' )THEN
597      tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1)
598      CALL grid_get_info(tl_bathy1)
599   ELSE
600      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid bathymetry "//&
601      &  "file. check namelist")
602   ENDIF
603
604   ! check
605   ! check output file do not already exist
606   ! WARNING: do not work when use time to create output file name
607   DO jk=1,ip_ncard
608      cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
609      &                                TRIM(cp_card(jk)), 1 )
610      INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist)
611      IF( ll_exist )THEN
612         CALL logger_fatal("CREATE BOUNDARY: output file "//TRIM(cl_bdyout)//&
613         &  " already exist.")
614      ENDIF
615
616      cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
617      &                                TRIM(cp_card(jk)) )
618      INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist)
619      IF( ll_exist )THEN
620         CALL logger_fatal("CREATE BOUNDARY: output file "//TRIM(cl_bdyout)//&
621         &  " already exist.")
622      ENDIF
623   ENDDO
624
625   ! check namelist
626   ! check refinement factor
627   il_rho(:)=1
628   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
629      CALL logger_error("CREATE BOUNDARY: invalid refinement factor."//&
630      &  " check namelist "//TRIM(cd_namelist))
631   ELSE
632      il_rho(jp_I)=in_rhoi
633      il_rho(jp_J)=in_rhoj
634   ENDIF
635
636   !
637   ! compute coarse grid indices around fine grid
638   il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, &
639   &                                 id_rho=il_rho(:))
640
641   il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2)
642   il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2)
643
644   ! check domain validity
645   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0)
646
647   ! check coordinate file
648   CALL grid_check_coincidence( tl_coord0, tl_coord1, &
649   &                            il_imin0, il_imax0, &
650   &                            il_jmin0, il_jmax0, &
651   &                            il_rho(:) )     
652
653   ! read or compute boundary
654   CALL mpp_get_contour(tl_bathy1)
655
656   CALL iom_mpp_open(tl_bathy1)
657 
658   tl_var1=iom_mpp_read_var(tl_bathy1,'Bathymetry')
659 
660   CALL iom_mpp_close(tl_bathy1)
661
662   ! get boundaries indices
663   tl_bdy(:)=boundary_init(tl_var1, ln_north, ln_south, ln_east, ln_west, &
664   &                                cn_north, cn_south, cn_east, cn_west, &
665   &                                ln_oneseg ) 
666
667
668   CALL var_clean(tl_var1)
669
670   ! compute level
671   ALLOCATE(tl_level(ip_npoint))
672   tl_level(:)=vgrid_get_level(tl_bathy1, cd_namelist )
673
674   ! get coordinate for each segment of each boundary
675   ALLOCATE( tl_segdom1(ip_npoint,ip_maxseg,ip_ncard) )
676   ALLOCATE( tl_seglvl1(ip_npoint,ip_maxseg,ip_ncard) )
677 
678   DO jl=1,ip_ncard
679      IF( tl_bdy(jl)%l_use )THEN
680         DO jk=1,tl_bdy(jl)%i_nseg
681
682            ! get fine grid segment domain
683            tl_segdom1(:,jk,jl)=create_boundary_get_dom( tl_bathy1, &
684            &                                            tl_bdy(jl), jk )
685
686            IF( .NOT. ln_extrap )THEN
687               ! get fine grid level
688               tl_seglvl1(:,jk,jl)= &
689                  & create_boundary_get_level( tl_level(:), &
690                  &                            tl_segdom1(:,jk,jl))
691            ENDIF
692
693            ! add extra band to fine grid domain (if possible)
694            ! to avoid dimension of one and so be able to compute offset
695            DO jj=1,ip_npoint
696               CALL dom_add_extra(tl_segdom1(jj,jk,jl), &
697               &                  il_rho(jp_I), il_rho(jp_J))
698            ENDDO
699
700         ENDDO
701      ENDIF
702   ENDDO
703
704   ! clean
705   CALL var_clean(tl_level(:))
706   DEALLOCATE(tl_level)
707
708   ! clean bathy
709   CALL mpp_clean(tl_bathy1)
710
711   ALLOCATE( tl_segvar1(tl_multi%i_nvar,ip_maxseg,ip_ncard) )
712   ! compute boundary for variable to be used (see namelist)
713   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
714      CALL logger_error("CREATE BOUNDARY: no file to work on. "//&
715      &                 "check cn_varfile in namelist.")
716   ELSE
717
718      jvar=0
719      ! for each file
720      DO ji=1,tl_multi%i_nmpp
721
722         WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1
723
724         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
725
726            CALL logger_error("CREATE BOUNDARY: no variable to work on for "//&
727            &                 "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//&
728            &                 ". check cn_varfile in namelist.")
729
730         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN
731         !- use input matrix to fill variable
732
733            WRITE(*,'(a)') "work on data"
734            ! for each variable initialise from matrix
735            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
736
737               jvar=jvar+1
738               WRITE(*,'(2x,a,a)') "work on variable "//&
739               &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
740
741               tl_var1=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
742
743               SELECT CASE(TRIM(tl_var1%c_point))
744               CASE DEFAULT !'T'
745                  jpoint=jp_T
746               CASE('U')
747                  jpoint=jp_U
748               CASE('V')
749                  jpoint=jp_V
750               CASE('F')
751                  jpoint=jp_F
752               END SELECT
753
754               WRITE(*,'(4x,a,a)') 'work on '//TRIM(tl_var1%c_name)
755               DO jl=1,ip_ncard
756                  IF( tl_bdy(jl)%l_use )THEN
757
758                     DO jk=1,tl_bdy(jl)%i_nseg
759
760                        ! fill value with matrix data
761                        tl_segvar1(jvar,jk,jl)=create_boundary_matrix( &
762                        &                          tl_var1, &
763                        &                          tl_segdom1(jpoint,jk,jl), &
764                        &                          in_nlevel )
765
766                        !del extra
767                        CALL dom_del_extra( tl_segvar1(jvar,jk,jl), &
768                        &                   tl_segdom1(jpoint,jk,jl) )
769
770                     ENDDO
771
772                  ENDIF
773               ENDDO
774               
775               ! clean
776               CALL var_clean(tl_var1)
777
778            ENDDO
779
780         !- end of use input matrix to fill variable
781         ELSE
782         !- use mpp file to fill variable
783
784            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name)
785            !
786            tl_mpp=mpp_init(file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name)))
787            CALL grid_get_info(tl_mpp)
788
789            DO jl=1,ip_ncard
790               IF( tl_bdy(jl)%l_use )THEN
791
792                  WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//&
793                     &  ' boundary'
794                  DO jk=1,tl_bdy(jl)%i_nseg
795
796                     ! for each variable of this file
797                     DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
798 
799                        WRITE(*,'(4x,a,a)') "work on variable "//&
800                        &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
801
802                        tl_var0=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
803
804                        ! open mpp file
805                        CALL iom_mpp_open(tl_mpp)
806
807                        ! get or check depth value
808                        CALL create_boundary_check_depth( tl_var0, tl_mpp, &
809                        &                                 in_nlevel, tl_depth )
810
811                        ! get or check time value
812                        CALL create_boundary_check_time( tl_var0, tl_mpp, &
813                        &                                tl_time )
814
815                        ! close mpp file
816                        CALL iom_mpp_close(tl_mpp)
817
818                        ! open mpp file on domain
819                        SELECT CASE(TRIM(tl_var0%c_point))
820                           CASE DEFAULT !'T'
821                              jpoint=jp_T
822                           CASE('U')
823                              jpoint=jp_U
824                           CASE('V')
825                              jpoint=jp_V
826                           CASE('F')
827                              jpoint=jp_F
828                        END SELECT
829
830                        tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl))
831
832                        CALL create_boundary_get_coord( tl_coord1, tl_dom1, &
833                        &                               tl_var0%c_point,    &
834                        &                               tl_lon1, tl_lat1 )
835
836                        ! get coarse grid indices of this segment
837                        il_ind(:,:)=grid_get_coarse_index(tl_coord0, &
838                        &                                 tl_lon1, tl_lat1, &
839                        &                                 id_rho=il_rho(:) )
840
841                        IF( ANY(il_ind(:,:)==0) )THEN
842                           CALL logger_error("CREATE BOUNDARY: error "//&
843                           &  "computing coarse grid indices")
844                        ELSE
845                           il_imin0=il_ind(1,1)
846                           il_imax0=il_ind(1,2)
847
848                           il_jmin0=il_ind(2,1)
849                           il_jmax0=il_ind(2,2)
850                        ENDIF
851
852                        il_offset(:,:)= grid_get_fine_offset( &
853                        &                    tl_coord0, &
854                        &                    il_imin0, il_jmin0,&
855                        &                    il_imax0, il_jmax0,&
856                        &                    tl_lon1%d_value(:,:,1,1),&
857                        &                    tl_lat1%d_value(:,:,1,1),&
858                        &                    il_rho(:),&
859                        &                    TRIM(tl_var0%c_point) )
860
861                        ! compute coarse grid segment domain
862                        tl_dom0=dom_init( tl_coord0,         &
863                        &                 il_imin0, il_imax0,&
864                        &                 il_jmin0, il_jmax0 )
865
866                        ! add extra band (if possible) to compute interpolation
867                        CALL dom_add_extra(tl_dom0)
868
869                        ! open mpp files
870                        CALL iom_dom_open(tl_mpp, tl_dom0)
871
872                        cl_name=tl_var0%c_name
873                        ! read variable value on domain
874                        tl_segvar1(jvar+jj,jk,jl)= &
875                        &    iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0)
876
877                        IF( ANY(il_rho(:)/=1) )THEN
878                           WRITE(*,'(4x,a,a)') "interp variable "//TRIM(cl_name)
879                           ! work on variable
880                           CALL create_boundary_interp( &
881                           &                 tl_segvar1(jvar+jj,jk,jl),&
882                           &                 il_rho(:), il_offset(:,:) )
883                        ENDIF
884
885                        ! remove extraband added to domain
886                        CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
887                        &                   tl_dom0, il_rho(:) )
888
889                        ! del extra point on fine grid
890                        CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
891                        &                   tl_dom1 )
892                        ! clean extra point information on coarse grid domain
893                        CALL dom_clean_extra( tl_dom0 )
894
895                        ! add attribute to variable
896                        tl_att=att_init('src_file',&
897                        &  TRIM(fct_basename(tl_mpp%c_name)))
898                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
899                        &                 tl_att)
900
901                        !
902                        tl_att=att_init('src_i_indices',&
903                        &  (/tl_dom0%i_imin, tl_dom0%i_imax/))
904                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
905                        &                 tl_att)
906
907                        tl_att=att_init('src_j_indices', &
908                        &  (/tl_dom0%i_jmin, tl_dom0%i_jmax/))
909                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
910                        &                 tl_att)
911
912                        IF( ANY(il_rho(:)/=1) )THEN
913                           tl_att=att_init("refinment_factor", &
914                           &               (/il_rho(jp_I),il_rho(jp_J)/))
915                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
916                           &                 tl_att)
917                        ENDIF
918
919                        ! clean structure
920                        CALL att_clean(tl_att)
921
922                        ! clean
923                        CALL dom_clean(tl_dom0)
924                        CALL dom_clean(tl_dom1)
925
926                        ! close mpp files
927                        CALL iom_dom_close(tl_mpp)
928
929                        ! clean structure
930                        CALL var_clean(tl_lon1)
931                        CALL var_clean(tl_lat1)
932                        CALL var_clean(tl_lvl1)
933
934                     ENDDO ! jj
935
936                     ! clean
937                     CALL var_clean(tl_var0)
938
939                  ENDDO ! jk
940           
941               ENDIF
942            ENDDO ! jl
943
944            jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
945
946            ! clean
947            CALL mpp_clean(tl_mpp)
948
949         !- end of use file to fill variable
950         ENDIF
951      ENDDO ! ji
952   ENDIF
953
954   IF( jvar /= tl_multi%i_nvar )THEN
955      CALL logger_error("CREATE BOUNDARY: it seems some variable "//&
956         &  "can not be read")
957   ENDIF
958
959   ! write file for each segment of each boundary
960   DO jl=1,ip_ncard
961      IF( tl_bdy(jl)%l_use )THEN
962
963         DO jk=1,tl_bdy(jl)%i_nseg
964            !-
965            CALL create_boundary_get_coord( tl_coord1, tl_segdom1(jp_T,jk,jl),&
966            &                               'T', tl_lon1, tl_lat1 )
967
968            ! force to use nav_lon, nav_lat as variable name
969            tl_lon1%c_name='nav_lon'
970            tl_lat1%c_name='nav_lat'
971
972            ! del extra point on fine grid
973            CALL dom_del_extra( tl_lon1, tl_segdom1(jp_T,jk,jl) )
974            CALL dom_del_extra( tl_lat1, tl_segdom1(jp_T,jk,jl) )
975
976            ! clean
977            DO jpoint=1,ip_npoint
978               CALL dom_clean(tl_segdom1(jpoint,jk,jl))
979            ENDDO
980
981            ! swap array
982            CALL boundary_swap(tl_lon1, tl_bdy(jl))
983            CALL boundary_swap(tl_lat1, tl_bdy(jl))
984            DO jvar=1,tl_multi%i_nvar
985
986               ! use additional request
987               ! change unit and apply factor
988               CALL var_chg_unit(tl_segvar1(jvar,jk,jl))
989
990               ! forced min and max value
991               CALL var_limit_value(tl_segvar1(jvar,jk,jl))
992
993               ! filter
994               CALL filter_fill_value(tl_segvar1(jvar,jk,jl))
995
996               IF( .NOT. ln_extrap )THEN
997                  ! use mask
998                  SELECT CASE(TRIM(tl_segvar1(jvar,jk,jl)%c_point))
999                  CASE DEFAULT !'T'
1000                     jpoint=jp_T
1001                  CASE('U')
1002                     jpoint=jp_U
1003                  CASE('V')
1004                     jpoint=jp_V
1005                  CASE('F')
1006                     jpoint=jp_F
1007                  END SELECT
1008
1009                  CALL create_boundary_use_mask(tl_segvar1(jvar,jk,jl), &
1010                  &                             tl_seglvl1(jpoint,jk,jl))
1011               ENDIF
1012
1013               ! swap dimension order
1014               CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl))
1015
1016            ENDDO
1017
1018            ! create file
1019            ! create file structure
1020            ! set file namearray of level variable structure
1021            IF( tl_bdy(jl)%i_nseg > 1 )THEN
1022               IF( ASSOCIATED(tl_time%d_value) )THEN
1023                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
1024                  tl_date=var_to_date(tl_time)
1025                  tl_date=tl_date+dn_dayofs
1026                  cl_date=date_print( tl_date, cl_fmt ) 
1027
1028                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
1029                  &                                TRIM(tl_bdy(jl)%c_card), jk,&
1030                  &                                cd_date=TRIM(cl_date) )
1031               ELSE
1032                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
1033                  &                                TRIM(tl_bdy(jl)%c_card), jk )
1034               ENDIF
1035            ELSE
1036               IF( ASSOCIATED(tl_time%d_value) )THEN
1037                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
1038                  tl_date=var_to_date(tl_time)
1039                  tl_date=tl_date+dn_dayofs
1040                  cl_date=date_print( tl_date, cl_fmt )
1041
1042                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
1043                  &                                TRIM(tl_bdy(jl)%c_card), &
1044                  &                                cd_date=TRIM(cl_date) )
1045               ELSE
1046                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
1047                  &                                TRIM(tl_bdy(jl)%c_card) )
1048               ENDIF
1049            ENDIF
1050            !
1051            tl_fileout=file_init(TRIM(cl_bdyout),id_perio=in_perio1)
1052
1053            ! add dimension
1054            tl_dim(:)=var_max_dim(tl_segvar1(:,jk,jl))
1055
1056            SELECT CASE(TRIM(tl_bdy(jl)%c_card))
1057               CASE DEFAULT ! 'north','south'
1058                  cl_dimorder='xyzt'
1059               CASE('east','west')
1060                  cl_dimorder='yxzt'
1061            END SELECT
1062
1063            DO ji=1,ip_maxdim
1064               IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
1065            ENDDO
1066
1067            ! add variables
1068            IF( ALL( tl_dim(1:2)%l_use ) )THEN
1069               ! add longitude
1070               CALL file_add_var(tl_fileout, tl_lon1)
1071               CALL var_clean(tl_lon1)
1072
1073               ! add latitude
1074               CALL file_add_var(tl_fileout, tl_lat1)
1075               CALL var_clean(tl_lat1)
1076            ENDIF
1077           
1078
1079
1080            IF( tl_dim(3)%l_use )THEN
1081               IF( ASSOCIATED(tl_depth%d_value) )THEN
1082                  ! add depth
1083                  CALL file_add_var(tl_fileout, tl_depth)
1084               ENDIF
1085            ENDIF
1086
1087            IF( tl_dim(4)%l_use )THEN
1088               IF( ASSOCIATED(tl_time%d_value) )THEN
1089                  ! add time
1090                  CALL file_add_var(tl_fileout, tl_time)
1091               ENDIF
1092            ENDIF
1093
1094            ! add other variable
1095            DO jvar=tl_multi%i_nvar,1,-1
1096               CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl))
1097               CALL var_clean(tl_segvar1(jvar,jk,jl))
1098            ENDDO
1099
1100            ! add some attribute
1101            tl_att=att_init("Created_by","SIREN create_boundary")
1102            CALL file_add_att(tl_fileout, tl_att)
1103
1104            cl_date=date_print(date_now())
1105            tl_att=att_init("Creation_date",cl_date)
1106            CALL file_add_att(tl_fileout, tl_att)
1107
1108            ! add shift on north and east boundary
1109            ! boundary compute on T point but express on U or V point
1110            SELECT CASE(TRIM(tl_bdy(jl)%c_card))
1111            CASE DEFAULT ! 'south','west'
1112               il_shift=0
1113            CASE('north','east')
1114               il_shift=1
1115            END SELECT
1116
1117            ! add indice of velocity row or column
1118            tl_att=att_init('bdy_ind',tl_bdy(jl)%t_seg(jk)%i_index-il_shift)
1119            CALL file_move_att(tl_fileout, tl_att)
1120
1121            ! add width of the relaxation zone
1122            tl_att=att_init('bdy_width',tl_bdy(jl)%t_seg(jk)%i_width)
1123            CALL file_move_att(tl_fileout, tl_att)
1124           
1125            ! add indice of segment start
1126            tl_att=att_init('bdy_deb',tl_bdy(jl)%t_seg(jk)%i_first)
1127            CALL file_move_att(tl_fileout, tl_att)
1128           
1129            ! add indice of segment end
1130            tl_att=att_init('bdy_end',tl_bdy(jl)%t_seg(jk)%i_last)
1131            CALL file_move_att(tl_fileout, tl_att)
1132                           
1133            ! clean
1134            CALL att_clean(tl_att)
1135
1136            ! create file
1137            CALL iom_create(tl_fileout)
1138
1139            ! write file
1140            CALL iom_write_file(tl_fileout, cl_dimorder)
1141
1142            ! close file
1143            CALL iom_close(tl_fileout)
1144            CALL file_clean(tl_fileout)
1145
1146         ENDDO ! jk
1147
1148      ENDIF
1149      ! clean
1150      CALL boundary_clean(tl_bdy(jl))
1151   ENDDO !jl
1152
1153   ! clean
1154   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth)
1155   IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time)
1156   DEALLOCATE( tl_segdom1 )
1157   DEALLOCATE( tl_segvar1 )
1158   CALL var_clean(tl_seglvl1(:,:,:))
1159   DEALLOCATE( tl_seglvl1 )
1160
1161
1162   CALL mpp_clean(tl_coord1)
1163   CALL mpp_clean(tl_coord0)
1164   CALL var_clean_extra()
1165
1166   CALL multi_clean(tl_multi)
1167
1168   ! close log file
1169   CALL logger_footer()
1170   CALL logger_close()
1171   CALL logger_clean()
1172
1173END SUBROUTINE create__boundary
1174   !-------------------------------------------------------------------
1175   !> @brief
1176   !> This subroutine compute boundary domain for each grid point (T,U,V,F)
1177   !>
1178   !> @author J.Paul
1179   !> @date November, 2013 - Initial Version
1180   !> @date September, 2014
1181   !> - take into account grid point to compute boundary indices
1182   !>
1183   !> @param[in] td_bathy1 file structure
1184   !> @param[in] td_bdy    boundary structure
1185   !> @param[in] id_seg    segment indice
1186   !> @return array of domain structure
1187   !-------------------------------------------------------------------
1188   FUNCTION create_boundary_get_dom( td_bathy1, td_bdy, id_seg )
1189
1190      IMPLICIT NONE
1191
1192      ! Argument
1193      TYPE(TMPP) , INTENT(IN   ) :: td_bathy1
1194      TYPE(TBDY) , INTENT(IN   ) :: td_bdy
1195      INTEGER(i4), INTENT(IN   ) :: id_seg
1196
1197      ! function
1198      TYPE(TDOM), DIMENSION(ip_npoint) :: create_boundary_get_dom
1199
1200      ! local variable
1201      INTEGER(i4) :: il_imin1
1202      INTEGER(i4) :: il_imax1
1203      INTEGER(i4) :: il_jmin1
1204      INTEGER(i4) :: il_jmax1
1205
1206      INTEGER(i4) :: il_imin
1207      INTEGER(i4) :: il_imax
1208      INTEGER(i4) :: il_jmin
1209      INTEGER(i4) :: il_jmax
1210
1211      INTEGER(i4), DIMENSION(ip_npoint) :: il_ishift
1212      INTEGER(i4), DIMENSION(ip_npoint) :: il_jshift
1213
1214      ! loop indices
1215      INTEGER(i4) :: ji
1216      INTEGER(i4) :: jk
1217      !----------------------------------------------------------------
1218      ! init
1219      jk=id_seg
1220
1221      il_ishift(:)=0
1222      il_jshift(:)=0
1223
1224      ! get boundary definition
1225      SELECT CASE(TRIM(td_bdy%c_card))
1226         CASE('north')
1227
1228            il_imin1=td_bdy%t_seg(jk)%i_first
1229            il_imax1=td_bdy%t_seg(jk)%i_last 
1230            il_jmin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1)
1231            il_jmax1=td_bdy%t_seg(jk)%i_index
1232
1233            il_jshift(jp_V)=-1
1234            il_jshift(jp_F)=-1
1235
1236         CASE('south')
1237
1238            il_imin1=td_bdy%t_seg(jk)%i_first
1239            il_imax1=td_bdy%t_seg(jk)%i_last 
1240            il_jmin1=td_bdy%t_seg(jk)%i_index
1241            il_jmax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1)
1242
1243         CASE('east')
1244
1245            il_imin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1)
1246            il_imax1=td_bdy%t_seg(jk)%i_index
1247            il_jmin1=td_bdy%t_seg(jk)%i_first
1248            il_jmax1=td_bdy%t_seg(jk)%i_last 
1249
1250            il_ishift(jp_U)=-1
1251            il_ishift(jp_F)=-1
1252
1253         CASE('west')
1254
1255            il_imin1=td_bdy%t_seg(jk)%i_index
1256            il_imax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1)
1257            il_jmin1=td_bdy%t_seg(jk)%i_first
1258            il_jmax1=td_bdy%t_seg(jk)%i_last 
1259
1260      END SELECT         
1261
1262      !-read fine grid domain
1263      DO ji=1,ip_npoint
1264
1265         ! shift domain
1266         il_imin=il_imin1+il_ishift(ji)
1267         il_imax=il_imax1+il_ishift(ji)
1268
1269         il_jmin=il_jmin1+il_jshift(ji)
1270         il_jmax=il_jmax1+il_jshift(ji)
1271
1272         ! compute domain
1273         create_boundary_get_dom(ji)=dom_init( td_bathy1,       &
1274         &                                     il_imin, il_imax,&
1275         &                                     il_jmin, il_jmax,&
1276         &                                     TRIM(td_bdy%c_card) )
1277
1278      ENDDO
1279
1280   END FUNCTION create_boundary_get_dom
1281   !-------------------------------------------------------------------
1282   !> @brief
1283   !> This subroutine get coordinates over boundary domain
1284   !>
1285   !> @author J.Paul
1286   !> @date November, 2013 - Initial Version
1287   !> @date September, 2014
1288   !> - take into account grid point
1289   !>
1290   !> @param[in] td_coord1 coordinates file structure
1291   !> @param[in] td_dom1   boundary domain structure
1292   !> @param[in] cd_point  grid point
1293   !> @param[out] td_lon1  longitude variable structure
1294   !> @param[out] td_lat1  latitude variable structure
1295   !-------------------------------------------------------------------
1296   SUBROUTINE create_boundary_get_coord( td_coord1, td_dom1, cd_point, &
1297   &                                     td_lon1, td_lat1 )
1298
1299      IMPLICIT NONE
1300      ! Argument
1301      TYPE(TMPP)      , INTENT(IN   ) :: td_coord1
1302      TYPE(TDOM)      , INTENT(IN   ) :: td_dom1
1303      CHARACTER(LEN=*), INTENT(IN   ) :: cd_point
1304      TYPE(TVAR)      , INTENT(  OUT) :: td_lon1
1305      TYPE(TVAR)      , INTENT(  OUT) :: td_lat1 
1306
1307      ! local variable
1308      TYPE(TMPP)        :: tl_coord1
1309     
1310      CHARACTER(LEN=lc) :: cl_name
1311      ! loop indices
1312      !----------------------------------------------------------------
1313      !read variables on domain (ugly way to do it, have to work on it)
1314      ! init mpp structure
1315      tl_coord1=mpp_copy(td_coord1)
1316     
1317      ! open mpp files
1318      CALL iom_dom_open(tl_coord1, td_dom1)
1319
1320      ! read variable value on domain
1321      WRITE(cl_name,*) 'longitude_'//TRIM(cd_point)
1322      td_lon1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1)
1323      WRITE(cl_name,*) 'latitude_'//TRIM(cd_point)
1324      td_lat1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1)
1325
1326      ! close mpp files
1327      CALL iom_dom_close(tl_coord1)
1328
1329      ! clean structure
1330      CALL mpp_clean(tl_coord1)
1331
1332   END SUBROUTINE create_boundary_get_coord
1333   !-------------------------------------------------------------------
1334   !> @brief
1335   !> This subroutine interpolate variable on boundary
1336   !>
1337   !> @details
1338   !>
1339   !> @author J.Paul
1340   !> @date November, 2013 - Initial Version
1341   !>
1342   !> @param[inout] td_var variable structure
1343   !> @param[in] id_rho    array of refinment factor
1344   !> @param[in] id_offset array of offset between fine and coarse grid
1345   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext)
1346   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext)
1347   !-------------------------------------------------------------------
1348   SUBROUTINE create_boundary_interp( td_var,           &
1349   &                                  id_rho,           &
1350   &                                  id_offset,        &
1351   &                                  id_iext, id_jext )
1352
1353      IMPLICIT NONE
1354
1355      ! Argument
1356      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
1357      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
1358      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
1359
1360      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
1361      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
1362
1363
1364      ! local variable
1365      INTEGER(i4) :: il_iext
1366      INTEGER(i4) :: il_jext
1367      ! loop indices
1368      !----------------------------------------------------------------
1369
1370      !WARNING: at least two extrabands are required for cubic interpolation
1371      il_iext=2
1372      IF( PRESENT(id_iext) ) il_iext=id_iext
1373
1374      il_jext=2
1375      IF( PRESENT(id_jext) ) il_jext=id_jext
1376
1377      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
1378         CALL logger_warn("CREATE BOUNDARY INTERP: at least extrapolation "//&
1379         &  "on two points are required with cubic interpolation ")
1380         il_iext=2
1381      ENDIF
1382
1383      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
1384         CALL logger_warn("CREATE BOUNDARY INTERP: at least extrapolation "//&
1385         &  "on two points are required with cubic interpolation ")
1386         il_jext=2
1387      ENDIF
1388
1389      ! work on variable
1390      ! add extraband
1391      CALL extrap_add_extrabands(td_var, il_iext, il_jext)
1392
1393      ! extrapolate variable
1394      CALL extrap_fill_value( td_var )
1395
1396      ! interpolate Bathymetry
1397      CALL interp_fill_value( td_var, id_rho(:), &
1398      &                       id_offset=id_offset(:,:) )
1399
1400      ! remove extraband
1401      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), &
1402         &                               il_jext*id_rho(jp_J))
1403
1404   END SUBROUTINE create_boundary_interp
1405   !-------------------------------------------------------------------
1406   !> @brief
1407   !> This function create variable, filled with matrix value
1408   !>
1409   !> @details
1410   !> A variable is create with the same name that the input variable,
1411   !> and with dimension of the coordinate file.
1412   !> Then the variable array of value is split into equal subdomain.
1413   !> Each subdomain is fill with the associated value of the matrix.
1414   !>
1415   !> @author J.Paul
1416   !> @date November, 2013 - Initial Version
1417   !>
1418   !> @param[in] td_var    variable structure
1419   !> @param[in] td_dom    domain structure
1420   !> @param[in] id_nlevel number of levels
1421   !> @return variable structure
1422   !-------------------------------------------------------------------
1423   FUNCTION create_boundary_matrix(td_var, td_dom, id_nlevel)
1424      IMPLICIT NONE
1425      ! Argument
1426      TYPE(TVAR) , INTENT(IN) :: td_var
1427      TYPE(TDOM) , INTENT(IN) :: td_dom
1428      INTEGER(i4), INTENT(IN) :: id_nlevel
1429
1430      ! function
1431      TYPE(TVAR) :: create_boundary_matrix
1432
1433      ! local variable
1434      INTEGER(i4)      , DIMENSION(3)                    :: il_dim
1435      INTEGER(i4)      , DIMENSION(3)                    :: il_size
1436      INTEGER(i4)      , DIMENSION(3)                    :: il_rest
1437
1438      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
1439      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_jshape
1440      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_kshape
1441
1442      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
1443
1444      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
1445
1446      ! loop indices
1447      INTEGER(i4) :: ji
1448      INTEGER(i4) :: jj
1449      INTEGER(i4) :: jk
1450      !----------------------------------------------------------------
1451
1452      ! write value on grid
1453      ! get matrix dimension
1454      il_dim(:)=td_var%t_dim(1:3)%i_len
1455
1456      tl_dim(jp_I:jp_J)=dim_copy(td_dom%t_dim(jp_I:jp_J))
1457      tl_dim(jp_K)%i_len=id_nlevel
1458
1459      ! split output domain in N subdomain depending of matrix dimension
1460      il_size(:) = tl_dim(1:3)%i_len / il_dim(:)
1461      il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:))
1462
1463      ALLOCATE( il_ishape(il_dim(1)+1) )
1464      il_ishape(:)=0
1465      DO ji=2,il_dim(1)+1
1466         il_ishape(ji)=il_ishape(ji-1)+il_size(1)
1467      ENDDO
1468      ! add rest to last cell
1469      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1)
1470     
1471      ALLOCATE( il_jshape(il_dim(2)+1) )
1472      il_jshape(:)=0
1473      DO jj=2,il_dim(2)+1
1474         il_jshape(jj)=il_jshape(jj-1)+il_size(2)
1475      ENDDO
1476      ! add rest to last cell
1477      il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2)
1478
1479      ALLOCATE( il_kshape(il_dim(3)+1) )
1480      il_kshape(:)=0
1481      DO jk=2,il_dim(3)+1
1482         il_kshape(jk)=il_kshape(jk-1)+il_size(3)
1483      ENDDO
1484      ! add rest to last cell
1485      il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3)
1486
1487      ! write ouput array of value
1488      ALLOCATE(dl_value( tl_dim(1)%i_len, &
1489      &                  tl_dim(2)%i_len, &
1490      &                  tl_dim(3)%i_len, &
1491      &                  tl_dim(4)%i_len) )
1492
1493      dl_value(:,:,:,:)=0
1494
1495      DO jk=2,il_dim(3)+1
1496         DO jj=2,il_dim(2)+1
1497            DO ji=2,il_dim(1)+1
1498               
1499               dl_value( 1+il_ishape(ji-1):il_ishape(ji), &
1500               &         1+il_jshape(jj-1):il_jshape(jj), &
1501               &         1+il_kshape(jk-1):il_kshape(jk), &
1502               &         1 ) = td_var%d_value(ji-1,jj-1,jk-1,1)
1503
1504            ENDDO
1505         ENDDO
1506      ENDDO
1507
1508      ! initialise variable with value
1509      create_boundary_matrix=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:))
1510
1511      DEALLOCATE(dl_value)
1512
1513   END FUNCTION create_boundary_matrix
1514   !-------------------------------------------------------------------
1515   !> @brief
1516   !> This subroutine use mask to filled land point with _FillValue
1517   !>
1518   !> @details
1519   !>
1520   !> @author J.Paul
1521   !> @date November, 2013 - Initial Version
1522   !>
1523   !> @param[inout] td_var variable structure
1524   !> @param[in] td_mask   mask variable structure
1525   !-------------------------------------------------------------------
1526   SUBROUTINE create_boundary_use_mask( td_var, td_mask )
1527
1528      IMPLICIT NONE
1529
1530      ! Argument
1531      TYPE(TVAR), INTENT(INOUT) :: td_var
1532      TYPE(TVAR), INTENT(IN   ) :: td_mask
1533
1534      ! local variable
1535      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_mask
1536
1537      ! loop indices
1538      INTEGER(i4) :: jk
1539      INTEGER(i4) :: jl
1540      !----------------------------------------------------------------
1541
1542      IF( ANY(td_var%t_dim(1:2)%i_len /= &
1543      &       td_mask%t_dim(1:2)%i_len) )THEN
1544         CALL logger_debug("     mask dimension ( "//&
1545         &              TRIM(fct_str(td_mask%t_dim(1)%i_len))//","//&
1546         &              TRIM(fct_str(td_mask%t_dim(2)%i_len))//")" )
1547         CALL logger_debug(" variable dimension ( "//&
1548         &              TRIM(fct_str(td_var%t_dim(1)%i_len))//","//&
1549         &              TRIM(fct_str(td_var%t_dim(2)%i_len))//")" )
1550         CALL logger_fatal("CREATE BOUNDARY USE MASK: mask and "//&
1551         &                 "variable dimension differ."   )
1552      ENDIF
1553
1554      ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &
1555      &                 td_var%t_dim(2)%i_len) )
1556
1557      il_mask(:,:)=INT(td_mask%d_value(:,:,1,1))
1558
1559      DO jl=1,td_var%t_dim(4)%i_len
1560         DO jk=1,td_var%t_dim(3)%i_len
1561            WHERE( il_mask(:,:) < jk ) td_var%d_value(:,:,jk,jl)=td_var%d_fill
1562         ENDDO
1563      ENDDO
1564
1565      DEALLOCATE( il_mask )
1566
1567   END SUBROUTINE create_boundary_use_mask
1568   !-------------------------------------------------------------------
1569   !> @brief
1570   !> This function extract level over domain on each grid point, and return
1571   !> array of variable structure
1572   !>
1573   !> @author J.Paul
1574   !> @date November, 2013 - Initial Version
1575   !>
1576   !> @param[in] td_level  array of level variable structure
1577   !> @param[in] td_dom    array of domain structure
1578   !> @return array of variable structure
1579   !-------------------------------------------------------------------
1580   FUNCTION create_boundary_get_level(td_level, td_dom)
1581      IMPLICIT NONE
1582      ! Argument
1583      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level
1584      TYPE(TDOM), DIMENSION(:), INTENT(IN) :: td_dom
1585
1586      ! function
1587      TYPE(TVAR), DIMENSION(ip_npoint) :: create_boundary_get_level
1588
1589      ! local variable
1590      TYPE(TVAR), DIMENSION(ip_npoint) :: tl_var
1591
1592      ! loop indices
1593      INTEGER(i4) :: ji
1594      !----------------------------------------------------------------
1595
1596      IF( SIZE(td_level(:)) /= ip_npoint .OR. &
1597      &   SIZE(td_dom(:)) /= ip_npoint )THEN
1598         CALL logger_error("CREATE BDY GET LEVEL: invalid dimension. "//&
1599         &  "check input array of level and domain.")
1600      ELSE
1601
1602         DO ji=1,ip_npoint
1603
1604            tl_var(ji)=var_copy(td_level(ji))
1605
1606            IF( ASSOCIATED(tl_var(ji)%d_value) ) DEALLOCATE(tl_var(ji)%d_value)
1607
1608            tl_var(ji)%t_dim(1)%i_len=td_dom(ji)%t_dim(1)%i_len
1609            tl_var(ji)%t_dim(2)%i_len=td_dom(ji)%t_dim(2)%i_len
1610            ALLOCATE(tl_var(ji)%d_value(tl_var(ji)%t_dim(1)%i_len, &
1611            &                           tl_var(ji)%t_dim(2)%i_len, &
1612            &                           tl_var(ji)%t_dim(3)%i_len, &
1613            &                           tl_var(ji)%t_dim(4)%i_len) )
1614
1615            tl_var(ji)%d_value(:,:,:,:) = &
1616            &  td_level(ji)%d_value( td_dom(ji)%i_imin:td_dom(ji)%i_imax, &
1617            &                        td_dom(ji)%i_jmin:td_dom(ji)%i_jmax, :, : )
1618
1619         ENDDO
1620         ! save result
1621         create_boundary_get_level(:)=var_copy(tl_var(:))
1622
1623         ! clean
1624         CALL var_clean(tl_var(:))
1625
1626      ENDIF
1627
1628   END FUNCTION create_boundary_get_level
1629   !-------------------------------------------------------------------
1630   !> @brief
1631   !> This subroutine check if variable need depth dimension,
1632   !> get depth variable value in an open mpp structure
1633   !> and check if agree with already input depth variable.
1634   !>
1635   !> @details
1636   !>
1637   !> @author J.Paul
1638   !> @date November, 2014 - Initial Version
1639   !> @date January, 2016
1640   !> - check if variable need/use depth dimension
1641   !>
1642   !> @param[in] td_var       variable structure
1643   !> @param[in] td_mpp       mpp structure
1644   !> @param[in] id_nlevel    mpp structure
1645   !> @param[inout] td_depth  depth variable structure
1646   !-------------------------------------------------------------------
1647   SUBROUTINE create_boundary_check_depth( td_var, td_mpp, id_nlevel, td_depth )
1648
1649      IMPLICIT NONE
1650
1651      ! Argument
1652      TYPE(TVAR) , INTENT(IN   ) :: td_var
1653      TYPE(TMPP) , INTENT(IN   ) :: td_mpp
1654      INTEGER(i4), INTENT(IN   ) :: id_nlevel
1655      TYPE(TVAR) , INTENT(INOUT) :: td_depth
1656
1657      ! local variable
1658      INTEGER(i4) :: il_varid
1659      TYPE(TVAR)  :: tl_depth
1660      ! loop indices
1661      !----------------------------------------------------------------
1662
1663      IF( td_var%t_dim(jp_K)%l_use .AND. &
1664      &   ( TRIM(td_var%c_axis) == '' .OR. &
1665      &     INDEX(TRIM(td_var%c_axis),'Z') /= 0 )&
1666      & )THEN
1667
1668         ! check vertical dimension
1669         IF( td_mpp%t_dim(jp_K)%l_use )THEN
1670            IF( td_mpp%t_dim(jp_K)%i_len /= id_nlevel .AND. &
1671              & td_mpp%t_dim(jp_K)%i_len /= 1 )THEN
1672               CALL logger_error("CREATE BOUNDARY: dimension in file "//&
1673               &  TRIM(td_mpp%c_name)//" not agree with namelist in_nlevel ")
1674            ENDIF
1675         ENDIF
1676
1677         ! get or check depth value
1678         IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
1679
1680            il_varid=td_mpp%t_proc(1)%i_depthid
1681            IF( ASSOCIATED(td_depth%d_value) )THEN
1682
1683               tl_depth=iom_mpp_read_var(td_mpp, il_varid)
1684
1685               IF( ANY( td_depth%d_value(:,:,:,:) /= &
1686               &        tl_depth%d_value(:,:,:,:) ) )THEN
1687
1688                  CALL logger_error("CREATE BOUNDARY: depth value "//&
1689                  &  "for variable "//TRIM(td_var%c_name)//&
1690                  &  "from "//TRIM(td_mpp%c_name)//" not conform "//&
1691                  &  " to those from former file(s).")
1692
1693               ENDIF
1694               CALL var_clean(tl_depth)
1695
1696            ELSE
1697               td_depth=iom_mpp_read_var(td_mpp,il_varid)
1698            ENDIF
1699
1700         ENDIF
1701      ELSE
1702         CALL logger_debug("CREATE BOUNDARY: no depth dimension use"//&
1703         &                 " for variable "//TRIM(td_var%c_name))
1704      ENDIF
1705     
1706   END SUBROUTINE create_boundary_check_depth
1707   !-------------------------------------------------------------------
1708   !> @brief
1709   !> This subroutine check if variable need time dimension,
1710   !> get date and time in an open mpp structure
1711   !> and check if agree with date and time already read.
1712   !>
1713   !> @details
1714   !>
1715   !> @author J.Paul
1716   !> @date November, 2014 - Initial Version
1717   !> @date January, 2016
1718   !> - check if variable need/use time dimension
1719   !>
1720   !> @param[in] td_var       variable structure
1721   !> @param[in] td_mpp      mpp structure
1722   !> @param[inout] td_time  time variable structure
1723   !-------------------------------------------------------------------
1724   SUBROUTINE create_boundary_check_time( td_var, td_mpp, td_time )
1725
1726      IMPLICIT NONE
1727
1728      ! Argument
1729      TYPE(TVAR), INTENT(IN   ) :: td_var
1730      TYPE(TMPP), INTENT(IN   ) :: td_mpp
1731      TYPE(TVAR), INTENT(INOUT) :: td_time
1732
1733      ! local variable
1734      INTEGER(i4) :: il_varid
1735      TYPE(TVAR)  :: tl_time
1736
1737      TYPE(TDATE) :: tl_date1
1738      TYPE(TDATE) :: tl_date2
1739      ! loop indices
1740      !----------------------------------------------------------------
1741      IF( td_var%t_dim(jp_L)%l_use .AND. &
1742      &   ( TRIM(td_var%c_axis) == '' .OR. &
1743      &     INDEX(TRIM(td_var%c_axis),'T') /= 0 )&
1744      & )THEN
1745
1746         ! get or check depth value
1747         IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
1748
1749            il_varid=td_mpp%t_proc(1)%i_timeid
1750            IF( ASSOCIATED(td_time%d_value) )THEN
1751
1752               tl_time=iom_mpp_read_var(td_mpp, il_varid)
1753
1754               tl_date1=var_to_date(td_time)
1755               tl_date2=var_to_date(tl_time)
1756               IF( tl_date1 - tl_date2 /= 0 )THEN
1757
1758                  CALL logger_warn("CREATE BOUNDARY: date from "//&
1759                  &  TRIM(td_mpp%c_name)//" not conform "//&
1760                  &  " to those from former file(s).")
1761
1762               ENDIF
1763               CALL var_clean(tl_time)
1764
1765            ELSE
1766               td_time=iom_mpp_read_var(td_mpp,il_varid)
1767            ENDIF
1768
1769         ENDIF
1770
1771      ELSE
1772         CALL logger_debug("CREATE BOUNDARY: no time dimension use"//&
1773         &                 " for variable "//TRIM(td_var%c_name))
1774      ENDIF
1775
1776   END SUBROUTINE create_boundary_check_time
1777END PROGRAM create_boundary
Note: See TracBrowser for help on using the repository browser.