source: utils/tools/SIREN/src/create_bathy.f90 @ 12080

Last change on this file since 12080 was 12080, checked in by jpaul, 10 months ago

update nemo trunk

File size: 47.8 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! DESCRIPTION:
6!> @file
7!> This program creates fine grid bathymetry file.
8!>
9!> @section sec1 method
10!> This bathymetry could be :
11!> - extracted from a wider fine grid bathymetry file
12!> - interpolated from a wider coarse grid bathymetry file
13!> - handwritten
14!>
15!> @image html  bathy_40.png
16!> <center>@image latex bathy_30.png
17!> </center>
18!>
19!> @section sec2 how to
20!> USAGE: create_bathy create_bathy.nam [-v] [-h]<br/>
21!>    - positional arguments:<br/>
22!>       - create_bathy.nam<br/>
23!>          namelist of create_bathy
24!>          @note
25!>             a template of the namelist could be created running (in templates directory):
26!>             @code{.sh}
27!>                python create_templates.py create_bathy
28!>             @endcode
29!>
30!>    - optional arguments:<br/>
31!>       - -h, --help<br/>
32!>          show this help message (and exit)<br/>
33!>       - -v, --version<br/>
34!>          show Siren's version   (and exit)
35!>
36!> @section sec_bathy create_bathy.nam
37!>    create_bathy.nam contains 7 sub-namelists:<br/>
38!>       - **namlog** to set logger parameters
39!>       - **namcfg** to set configuration file parameters
40!>       - **namsrc** to set source/coarse grid parameters
41!>       - **namtgt** to set target/fine grid parameters
42!>       - **namvar** to set variable parameters
43!>       - **namnst** to set sub domain and nesting paramters
44!>       - **namout** to set output parameters
45!>
46!>    here after, each sub-namelist parameters is detailed.
47!>    @note
48!>       default values are specified between brackets
49!>
50!> @subsection sublog namlog
51!>    the logger sub-namelist parameters are :
52!>
53!>    - **cn_logfile** [@a create_bathy.log]<br/>
54!>       logger filename
55!>
56!>    - **cn_verbosity** [@a warning]<br/>
57!>       verbosity level, choose between :
58!>          - trace
59!>          - debug
60!>          - info
61!>          - warning
62!>          - error
63!>          - fatal
64!>          - none
65!>
66!>    - **in_maxerror** [@a 5]<br/>
67!>       maximum number of error allowed
68!>
69!> @subsection subcfg namcfg
70!>    the configuration sub-namelist parameters are :
71!>
72!>    - **cn_varcfg** [@a ./cfg/variable.cfg]<br/>
73!>       path to the variable configuration file.<br/>
74!>       the variable configuration file defines standard name,
75!>       default interpolation method, axis,...
76!>       to be used for some known variables.<br/>
77!>
78!>    - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/>
79!>       path to the dimension configuration file.<br/>
80!>       the dimension configuration file defines dimensions allowed.<br/>
81!>
82!>    - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/>
83!>       path to the useless (dummy) configuration file.<br/>
84!>       the dummy configuration file defines useless
85!>       dimension or variable. these dimension(s) or variable(s) will not be
86!>       processed.<br/>
87!>
88!> @subsection subsrc namsrc
89!>    the source/coarse grid sub-namelist parameters are :
90!>
91!>    - **cn_coord0** [@a ]<br/>
92!>       path to the coordinate file
93!>
94!>    - **in_perio0** [@a ]<br/>
95!>       NEMO periodicity index<br/>
96!>       the NEMO periodicity could be choose between 0 to 6:
97!>       <dl>
98!>          <dt>in_perio=0</dt>
99!>          <dd>standard regional model</dd>
100!>          <dt>in_perio=1</dt>
101!>          <dd>east-west cyclic model</dd>
102!>          <dt>in_perio=2</dt>
103!>          <dd>model with symmetric boundary condition across the equator</dd>
104!>          <dt>in_perio=3</dt>
105!>          <dd>regional model with North fold boundary and T-point pivot</dd>
106!>          <dt>in_perio=4</dt>
107!>          <dd>global model with a T-point pivot.<br/>
108!>          example: ORCA2, ORCA025, ORCA12</dd>
109!>          <dt>in_perio=5</dt>
110!>          <dd>regional model with North fold boundary and F-point pivot</dd>
111!>          <dt>in_perio=6</dt>
112!>          <dd>global model with a F-point pivot<br/>
113!>          example: ORCA05</dd>
114!>          </dd>
115!>       </dl>
116!>       @sa For more information see @ref md_src_docsrc_6_perio
117!>       and Model Boundary Condition paragraph in the
118!>       [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf)
119!>
120!> @subsection subtgt namtgt
121!>    the target/fine grid sub-namelist parameters are :
122!>
123!>    - **cn_coord1** [@a ]<br/>
124!>       path to coordinate file
125!>
126!>    - **in_perio1** [@a ]<br/>
127!>       NEMO periodicity index (see above)
128!>    @note if the fine/target coordinates file (cn_coord1) was created by SIREN, you do
129!>    not need to fill this parameter. SIREN will read it on the global attributes of
130!>    the coordinates file.
131!>
132!>    - **ln_fillclosed** [@a .TRUE.]<br/>
133!>       logical to fill closed sea or not
134!>
135!> @subsection subvar namvar
136!>    the variable sub-namelist parameters are :
137!>
138!>    - **cn_varfile** [@a ]<br/>
139!>       list of variable, and associated file
140!>       @warning
141!>          variable name must be __Bathymetry__ here.
142!>
143!>       *cn_varfile* is the path and filename of the file where find
144!>       variable.
145!>       @note
146!>          *cn_varfile* could be a matrix of value, if you want to handwrite
147!>          variable value.<br/>
148!>          the variable array of value is split into equal subdomain.<br/>
149!>          each subdomain is filled with the corresponding value
150!>          of the matrix.<br/>         
151!>          separators used to defined matrix are:
152!>             - ',' for line
153!>             - '/' for row
154!>             Example:<br/>
155!>                3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
156!>                                      3 & 2 & 3 \\
157!>                                      1 & 4 & 5 \end{array} \right) @f$
158!>
159!>       Examples:
160!>          - 'Bathymetry:gridT.nc'
161!>          - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000'<br/>
162!>
163!>       @note
164!>          Optionnaly, NEMO periodicity could be added following the filename.
165!>          the periodicity must be separated by ';'
166!>
167!>       Example:
168!>          - 'Bathymetry:gridT.nc ; perio=4'<br/>
169!>
170!>    - **cn_varinfo** [@a ]<br/>
171!>       list of variable and extra information about request(s) to be used<br/>
172!>
173!>       each elements of *cn_varinfo* is a string character (separated by ',').<br/>
174!>       it is composed of the variable name follow by ':',
175!>       then request(s) to be used on this variable.<br/>
176!>       request could be:
177!>          - int = interpolation method
178!>          - ext = extrapolation method
179!>          - flt = filter method
180!>          - min = minimum value
181!>          - max = maximum value
182!>          - unt = new units
183!>          - unf = unit scale factor (linked to new units)
184!>
185!>             requests must be separated by ';'.<br/>
186!>             order of requests does not matter.<br/>
187!>
188!>       informations about available method could be find in @ref interp,
189!>       @ref extrap and @ref filter modules.<br/>
190!>       Example:
191!>          - 'Bathymetry: flt=2*hamming(2,3); min=0'
192!>
193!>       @note
194!>          If you do not specify a method which is required,
195!>          default one is apply.
196!>
197!>    - **ln_rand** [@a .False.]<br/>
198!>          logical to add random value to Bathymetry<br/>
199!>          Only for handmade Bathymetry.
200!>          A random value (+/- 0.1% of the maximum depth) will
201!>          will be added to avoid flat Bathymetry (which may cause issue).
202!>
203!> @subsection subnst namnst
204!>    the nesting sub-namelist parameters are :
205!>
206!>    - **in_rhoi**  [@a 1]<br/>
207!>       refinement factor in i-direction
208!>
209!>    - **in_rhoj**  [@a 1]<br/>
210!>       refinement factor in j-direction
211!>
212!>    @note
213!>       coarse grid indices will be deduced from fine grid
214!>       coordinate file.
215!>
216!> @subsection subout namout
217!>    the output sub-namelist parameter is :
218!>
219!>    - **cn_fileout** [@a bathy_fine.nc]<br/>
220!>       output bathymetry filename
221!>
222!> <hr>
223!> @author J.Paul
224!>
225!> @date November, 2013 - Initial Version
226!> @date Sepember, 2014
227!> - add header for user
228!> - Bug fix, compute offset depending of grid point
229!> @date June, 2015
230!> - extrapolate all land points.
231!> - allow to change unit.
232!> @date September, 2015
233!> - manage useless (dummy) variable, attributes, and dimension
234!> @date January,2016
235!> - add create_bathy_check_depth as in create_boundary
236!> - add create_bathy_check_time  as in create_boundary
237!> @date February, 2016
238!> - do not closed sea for east-west cyclic domain
239!> @date October, 2016
240!> - dimension to be used select from configuration file
241!> @date July, 2017
242!> - add random value to avoid flat bathymetry
243!> @date January, 2019
244!> - add option to add random value to a flat Bathymetry
245!> - create and clean file structure to avoid memory leaks
246!> - check dimension of matrix for 'handmade' bathymetry
247!> - add url path to global attributes of output file(s)
248!> @date February, 2019
249!> - rename sub namelist namcrs to namsrc
250!> - rename sub namelist namfin to namtgt
251!> @date August, 2019
252!> - use periodicity read from namelist, and store in multi structure
253!> @date Ocober, 2019
254!> - add help and version optional arguments
255!>
256!> @todo
257!> - check tl_multi is not empty
258!>
259!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
260!----------------------------------------------------------------------
261PROGRAM create_bathy
262
263   USE global                          ! global variable
264   USE kind                            ! F90 kind parameter
265   USE logger                          ! log file manager
266   USE fct                             ! basic useful function
267   USE date                            ! date manager
268   USE att                             ! attribute manager
269   USE dim                             ! dimension manager
270   USE var                             ! variable manager
271   USE file                            ! file manager
272   USE multi                           ! multi file manager
273   USE iom                             ! I/O manager
274   USE grid                            ! grid manager
275   USE extrap                          ! extrapolation manager
276   USE interp                          ! interpolation manager
277   USE filter                          ! filter manager
278   USE mpp                             ! MPP manager
279   USE dom                             ! domain manager
280   USE iom_mpp                         ! MPP I/O manager
281   USE iom_dom                         ! DOM I/O manager
282
283   IMPLICIT NONE
284
285   ! parameters
286   CHARACTER(LEN=lc), PARAMETER  :: cp_myname = "create_bathy"
287
288   ! local variable
289   CHARACTER(LEN=lc)                                  :: cl_arg
290   CHARACTER(LEN=lc)                                  :: cl_namelist
291   CHARACTER(LEN=lc)                                  :: cl_date
292   CHARACTER(LEN=lc)                                  :: cl_data
293   CHARACTER(LEN=lc)                                  :: cl_url
294   CHARACTER(LEN=lc)                                  :: cl_errormsg
295
296   INTEGER(i4)                                        :: il_narg
297   INTEGER(i4)                                        :: il_status
298   INTEGER(i4)                                        :: il_fileid
299   INTEGER(i4)                                        :: il_varid
300   INTEGER(i4)                                        :: il_attid
301   INTEGER(i4)                                        :: il_imin0
302   INTEGER(i4)                                        :: il_imax0
303   INTEGER(i4)                                        :: il_jmin0
304   INTEGER(i4)                                        :: il_jmax0
305   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
306   INTEGER(i4)      , DIMENSION(2,2)                  :: il_offset
307   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
308   INTEGER(i4)      , DIMENSION(:,:)    , ALLOCATABLE :: il_mask
309
310   LOGICAL                                            :: ll_exist
311   LOGICAL                                            :: ll_fillclosed
312
313   TYPE(TMPP)                                         :: tl_coord0
314   TYPE(TMPP)                                         :: tl_coord1
315   TYPE(TMPP)                                         :: tl_mpp
316   TYPE(TFILE)                                        :: tl_fileout
317
318   TYPE(TATT)                                         :: tl_att
319   
320   TYPE(TVAR)                                         :: tl_lon
321   TYPE(TVAR)                                         :: tl_lat
322   TYPE(TVAR)                                         :: tl_depth
323   TYPE(TVAR)                                         :: tl_time
324
325   TYPE(TVAR)                                         :: tl_tmp
326   TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE       :: tl_var
327   
328   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
329
330   TYPE(TFILE)                                        :: tl_file
331
332   TYPE(TMULTI)                                       :: tl_multi
333
334   REAL(dp)                                           :: dl_minbat
335
336   ! loop indices
337   INTEGER(i4) :: ji
338   INTEGER(i4) :: jj
339   INTEGER(i4) :: jk
340
341   ! namelist variable
342   ! namlog
343   CHARACTER(LEN=lc)                       :: cn_logfile    = 'create_bathy.log' 
344   CHARACTER(LEN=lc)                       :: cn_verbosity  = 'warning' 
345   INTEGER(i4)                             :: in_maxerror   = 5
346
347   ! namcfg
348   CHARACTER(LEN=lc)                       :: cn_varcfg  = './cfg/variable.cfg' 
349   CHARACTER(LEN=lc)                       :: cn_dimcfg  = './cfg/dimension.cfg'
350   CHARACTER(LEN=lc)                       :: cn_dumcfg  = './cfg/dummy.cfg'
351
352   ! namsrc
353   CHARACTER(LEN=lc)                       :: cn_coord0  = '' 
354   INTEGER(i4)                             :: in_perio0  = -1
355
356   ! namtgt
357   CHARACTER(LEN=lc)                       :: cn_coord1  = ''
358   INTEGER(i4)                             :: in_perio1  = -1
359   LOGICAL                                 :: ln_fillclosed = .TRUE.
360
361   ! namvar
362   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
363   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
364   LOGICAL                                 :: ln_rand    = .FALSE.
365
366   ! namnst
367   INTEGER(i4)                             :: in_rhoi    = 1
368   INTEGER(i4)                             :: in_rhoj    = 1
369
370   ! namout
371   CHARACTER(LEN=lc)                       :: cn_fileout = 'bathy_fine.nc' 
372   !-------------------------------------------------------------------
373
374   NAMELIST /namlog/ &  !< logger namelist
375   &  cn_logfile,    &  !< log file
376   &  cn_verbosity,  &  !< log verbosity
377   &  in_maxerror       !< logger maximum error
378
379   NAMELIST /namcfg/ &  !< configuration namelist
380   &  cn_varcfg,     &  !< variable configuration file
381   &  cn_dimcfg,     &  !< dimension configuration file
382   &  cn_dumcfg         !< dummy configuration file
383
384   NAMELIST /namsrc/ &  !< source/coarse grid namelist
385   &  cn_coord0,     &  !< coordinate file
386   &  in_perio0         !< periodicity index
387
388   NAMELIST /namtgt/ &  !< target/fine grid namelist
389   &  cn_coord1,     &  !< coordinate file
390   &  in_perio1,     &  !< periodicity index
391   &  ln_fillclosed     !< fill closed sea
392 
393   NAMELIST /namvar/ &  !< variable namelist
394   &  cn_varfile,    &  !< list of variable file
395   &  cn_varinfo,    &  !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' )
396   &  ln_rand           !< add random value to avoid flat bathymetry
397 
398   NAMELIST /namnst/ &  !< nesting namelist
399   &  in_rhoi,       &  !< refinement factor in i-direction
400   &  in_rhoj           !< refinement factor in j-direction
401
402   NAMELIST /namout/ &  !< output namelist
403   &  cn_fileout        !< fine grid bathymetry file
404   !-------------------------------------------------------------------
405
406   !
407   ! Initialisation
408   ! --------------
409   !
410   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
411
412   ! Traitement des arguments fournis
413   ! --------------------------------
414   IF( il_narg /= 1 )THEN
415      WRITE(cl_errormsg,*) ' ERROR : one argument is needed '
416      CALL fct_help(cp_myname,cl_errormsg) 
417      CALL EXIT(1)
418   ELSE
419
420      CALL GET_COMMAND_ARGUMENT(1,cl_arg) !f03 intrinsec
421      SELECT CASE (cl_arg)
422         CASE ('-v', '--version')
423
424            CALL fct_version(cp_myname)
425            CALL EXIT(0)
426
427         CASE ('-h', '--help')
428
429            CALL fct_help(cp_myname)
430            CALL EXIT(0)
431
432         CASE DEFAULT
433
434            cl_namelist=cl_arg
435
436            ! read namelist
437            INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
438            IF( ll_exist )THEN
439
440               il_fileid=fct_getunit()
441
442               OPEN( il_fileid, FILE=TRIM(cl_namelist),  &
443               &                FORM='FORMATTED',        &
444               &                ACCESS='SEQUENTIAL',     &
445               &                STATUS='OLD',            &
446               &                ACTION='READ',           &
447               &                IOSTAT=il_status)
448               CALL fct_err(il_status)
449               IF( il_status /= 0 )THEN
450                  WRITE(cl_errormsg,*) " ERROR : error opening "//TRIM(cl_namelist)
451                  CALL fct_help(cp_myname,cl_errormsg) 
452                  CALL EXIT(1)
453               ENDIF
454
455               READ( il_fileid, NML = namlog )
456 
457               ! define logger file
458               CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
459               CALL logger_header()
460
461               READ( il_fileid, NML = namcfg )
462               ! get variable extra information on configuration file
463               CALL var_def_extra(TRIM(cn_varcfg))
464
465               ! get dimension allowed
466               CALL dim_def_extra(TRIM(cn_dimcfg))
467
468               ! get dummy variable
469               CALL var_get_dummy(TRIM(cn_dumcfg))
470               ! get dummy dimension
471               CALL dim_get_dummy(TRIM(cn_dumcfg))
472               ! get dummy attribute
473               CALL att_get_dummy(TRIM(cn_dumcfg))
474
475               READ( il_fileid, NML = namsrc )
476               READ( il_fileid, NML = namtgt )
477               READ( il_fileid, NML = namvar )
478               ! add user change in extra information
479               CALL var_chg_extra( cn_varinfo )
480               ! match variable with file
481               tl_multi=multi_init(cn_varfile)
482
483               READ( il_fileid, NML = namnst )
484               READ( il_fileid, NML = namout )
485
486               CLOSE( il_fileid, IOSTAT=il_status )
487               CALL fct_err(il_status)
488               IF( il_status /= 0 )THEN
489                  CALL logger_error("CREATE BATHY: closing "//TRIM(cl_namelist))
490               ENDIF
491
492            ELSE
493
494               WRITE(cl_errormsg,*) " ERROR : can't find "//TRIM(cl_namelist)
495               CALL fct_help(cp_myname,cl_errormsg) 
496               CALL EXIT(1)
497
498            ENDIF
499
500      END SELECT
501   ENDIF
502
503   CALL multi_print(tl_multi)
504
505   ! open files
506   IF( TRIM(cn_coord0) /= '' )THEN
507      tl_file=file_init(TRIM(cn_coord0))
508      tl_coord0=mpp_init( tl_file, id_perio=in_perio0)
509      ! clean
510      CALL file_clean(tl_file)
511      CALL grid_get_info(tl_coord0)
512   ELSE
513      CALL logger_fatal("CREATE BATHY: no coarse grid coordinate found. "//&
514      &     "check namelist")     
515   ENDIF
516
517   IF( TRIM(cn_coord1) /= '' )THEN
518      tl_file=file_init(TRIM(cn_coord1))
519      tl_coord1=mpp_init( tl_file, id_perio=in_perio1)
520      ! clean
521      CALL file_clean(tl_file)
522      CALL grid_get_info(tl_coord1)
523   ELSE
524      CALL logger_fatal("CREATE BATHY: no fine grid coordinate found. "//&
525      &     "check namelist")
526   ENDIF
527
528   ! do not closed sea for east-west cyclic domain
529   ll_fillclosed=ln_fillclosed
530   IF( tl_coord1%i_perio == 1 ) ll_fillclosed=.FALSE.
531
532   ! check
533   ! check output file do not already exist
534   INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist)
535   IF( ll_exist )THEN
536      CALL logger_fatal("CREATE BATHY: output file "//TRIM(cn_fileout)//&
537      &  " already exist.")
538   ENDIF
539
540   ! check namelist
541   ! check refinement factor
542   il_rho(:)=1
543   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
544      CALL logger_error("CREATE BATHY: invalid refinement factor."//&
545      &  " check namelist "//TRIM(cl_namelist))
546   ELSE
547      il_rho(jp_I)=in_rhoi
548      il_rho(jp_J)=in_rhoj
549   ENDIF
550
551   ! check domain indices
552   ! compute coarse grid indices around fine grid
553   il_ind(:,:)=grid_get_coarse_index( tl_coord0, tl_coord1, &
554   &                                  id_rho=il_rho(:) )
555
556   il_imin0=il_ind(jp_I,1) ; il_imax0=il_ind(jp_I,2)
557   il_jmin0=il_ind(jp_J,1) ; il_jmax0=il_ind(jp_J,2)
558
559   ! check domain validity
560   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0)
561
562   ! check coincidence between coarse and fine grid
563   CALL grid_check_coincidence( tl_coord0, tl_coord1, &
564   &                            il_imin0, il_imax0, &
565   &                            il_jmin0, il_jmax0, &
566   &                            il_rho(:) )
567
568   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
569      CALL logger_error("CREATE BATHY: no mpp file to work on. "//&
570      &                 "check cn_varfile in namelist.")
571   ELSE
572
573      ALLOCATE( tl_var( tl_multi%i_nvar ) )
574      jk=0
575      DO ji=1,tl_multi%i_nmpp
576     
577         WRITE(cl_data,'(a,i2.2)') 'data-',jk+1
578         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
579
580            CALL logger_fatal("CREATE BATHY: no variable to work on for "//&
581            &                 "mpp file"//TRIM(tl_multi%t_mpp(ji)%c_name)//&
582            &                 ". check cn_varfile in namelist.")
583
584         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN
585
586            !- use input matrix to initialise variable
587            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
588               jk=jk+1
589               tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
590
591               IF( COUNT(tl_tmp%t_dim(:)%l_use) > 2 )THEN
592                  CALL logger_fatal("CREATE BATHY: input matrix use more "//&
593                     &              "than 2D. Check namelist.")
594               ENDIF
595               tl_var(jk)=create_bathy_matrix(tl_tmp, tl_coord1, ln_rand)
596            ENDDO
597            ! clean
598            CALL var_clean(tl_tmp)
599
600         ELSE
601
602            tl_file=file_init(TRIM(tl_multi%t_mpp(ji)%c_name), &
603               &              id_perio=tl_multi%t_mpp(ji)%i_perio)
604            tl_mpp=mpp_init( tl_file )
605
606            ! clean
607            CALL file_clean(tl_file)
608            CALL grid_get_info(tl_mpp)
609
610            ! open mpp file
611            CALL iom_mpp_open(tl_mpp)
612
613            ! get or check depth value
614            CALL create_bathy_check_depth( tl_mpp, tl_depth )
615
616            ! get or check time value
617            CALL create_bathy_check_time( tl_mpp, tl_time )
618
619            ! close mpp file
620            CALL iom_mpp_close(tl_mpp)
621
622            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len).OR.&
623            &   ALL(il_rho(:)==1) )THEN
624               !- extract bathymetry from fine grid bathymetry
625               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
626                  jk=jk+1
627                  tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
628 
629                  tl_var(jk)=create_bathy_extract( tl_tmp, tl_mpp, &
630                  &                                tl_coord1 )
631               ENDDO
632               ! clean
633               CALL var_clean(tl_tmp)
634            ELSE
635               !- get bathymetry from coarse grid bathymetry
636               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
637                  jk=jk+1
638                  tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
639
640                  il_offset(:,:)= grid_get_fine_offset(tl_coord0,    &
641                  &                                    il_imin0, il_jmin0, &
642                  &                                    il_imax0, il_jmax0, &
643                  &                                    tl_coord1,          &
644                  &                                    il_rho(:),          &
645                  &                                    TRIM(tl_tmp%c_point) )
646
647                  tl_var(jk)=create_bathy_get_var( tl_tmp, tl_mpp,     &
648                  &                                il_imin0, il_jmin0, &
649                  &                                il_imax0, il_jmax0, &
650                  &                                il_offset(:,:),  &
651                  &                                il_rho(:) )
652               ENDDO
653               ! clean
654               CALL var_clean(tl_tmp)
655            ENDIF
656
657            ! clean structure
658            CALL mpp_clean(tl_mpp)
659
660         ENDIF
661      ENDDO
662   ENDIF
663
664   ! use additional request
665   DO jk=1,tl_multi%i_nvar
666
667         ! change unit and apply factor
668         CALL var_chg_unit(tl_var(jk))
669
670         ! forced min and max value
671         CALL var_limit_value(tl_var(jk))
672
673         ! fill closed sea
674         IF( ll_fillclosed )THEN
675            ALLOCATE( il_mask(tl_var(jk)%t_dim(1)%i_len, &
676            &                 tl_var(jk)%t_dim(2)%i_len) )
677
678            ! split domain in N sea subdomain
679            il_mask(:,:)=grid_split_domain(tl_var(jk))
680
681            !  fill smallest domain
682            CALL grid_fill_small_dom( tl_var(jk), il_mask(:,:) )
683
684            DEALLOCATE( il_mask )
685         ENDIF
686
687         ! filter
688         CALL filter_fill_value(tl_var(jk))
689
690         ! check bathymetry
691         dl_minbat=MINVAL(tl_var(jk)%d_value(:,:,:,:))
692         IF( TRIM(tl_var(jk)%c_stdname) == 'bathymetry' .AND. &
693         &   dl_minbat <= 0._dp  )THEN
694            CALL logger_debug("CREATE BATHY: min value "//TRIM(fct_str(dl_minbat)))
695            CALL logger_fatal("CREATE BATHY: Bathymetry has value <= 0")
696         ENDIF
697
698   ENDDO
699
700   ! create file
701   tl_fileout=file_init(TRIM(cn_fileout))
702
703   ! add dimension
704   tl_dim(:)=var_max_dim(tl_var(:))
705
706   DO ji=1,ip_maxdim
707      IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
708   ENDDO
709
710   ! add variables
711   IF( ALL( tl_dim(1:2)%l_use ) )THEN
712
713      ! open mpp files
714      CALL iom_mpp_open(tl_coord1)
715
716      ! add longitude
717      il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'longitude')
718      IF( il_varid == 0 )THEN
719         il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'longitude_T')
720      ENDIF
721      tl_lon=iom_mpp_read_var(tl_coord1, il_varid)
722      CALL file_add_var(tl_fileout, tl_lon)
723      CALL var_clean(tl_lon)
724
725      ! add latitude
726      il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'latitude')
727      IF( il_varid == 0 )THEN
728         il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'latitude_T')
729      ENDIF
730      tl_lat=iom_mpp_read_var(tl_coord1, il_varid)
731      CALL file_add_var(tl_fileout, tl_lat)
732      CALL var_clean(tl_lat)
733
734      ! close mpp files
735      CALL iom_mpp_close(tl_coord1)
736
737   ENDIF
738
739   IF( tl_dim(3)%l_use )THEN
740      ! add depth
741      CALL file_add_var(tl_fileout, tl_depth)
742      CALL var_clean(tl_depth)
743   ENDIF
744
745   IF( tl_dim(4)%l_use )THEN
746      ! add time
747      CALL file_add_var(tl_fileout, tl_time)
748      CALL var_clean(tl_time)
749   ENDIF
750
751   ! add other variables
752   DO jk=tl_multi%i_nvar,1,-1
753      CALL file_add_var(tl_fileout, tl_var(jk))
754      CALL var_clean(tl_var(jk))
755   ENDDO
756   DEALLOCATE(tl_var)
757
758   ! clean
759   CALL multi_clean(tl_multi)
760
761   ! add some attribute
762   tl_att=att_init("Created_by","SIREN create_bathy")
763   CALL file_add_att(tl_fileout, tl_att)
764
765   !add source url
766   cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:')
767   tl_att=att_init("SIREN_url",cl_url)
768   CALL file_add_att(tl_fileout, tl_att)
769
770   ! add date of creation
771   cl_date=date_print(date_now())
772   tl_att=att_init("Creation_date",cl_date)
773   CALL file_add_att(tl_fileout, tl_att)
774
775   ! add attribute periodicity
776   il_attid=0
777   IF( ASSOCIATED(tl_fileout%t_att) )THEN
778      il_attid=att_get_index(tl_fileout%t_att(:),'periodicity')
779   ENDIF
780   IF( tl_coord1%i_perio >= 0 .AND. il_attid == 0 )THEN
781      tl_att=att_init('periodicity',tl_coord1%i_perio)
782      CALL file_add_att(tl_fileout,tl_att)
783   ENDIF
784
785   ! add attribute east west overlap
786   il_attid=0
787   IF( ASSOCIATED(tl_fileout%t_att) )THEN
788      il_attid=att_get_index(tl_fileout%t_att(:),'ew_overlap')
789   ENDIF
790   IF( tl_coord1%i_ew >= 0 .AND. il_attid == 0 )THEN
791      tl_att=att_init('ew_overlap',tl_coord1%i_ew)
792      CALL file_add_att(tl_fileout,tl_att)
793   ENDIF
794   
795   ! create file
796   CALL iom_create(tl_fileout)
797
798   ! write file
799   CALL iom_write_file(tl_fileout)
800
801   ! close file
802   CALL iom_close(tl_fileout)
803
804   ! clean
805   CALL att_clean(tl_att)
806
807   CALL file_clean(tl_fileout)
808   CALL mpp_clean(tl_coord1)
809   CALL mpp_clean(tl_coord0)
810   CALL var_clean_extra()
811
812   ! close log file
813   CALL logger_footer()
814   CALL logger_close()
815
816CONTAINS
817   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
818   FUNCTION create_bathy_matrix(td_var, td_coord, ld_rand) &
819         & RESULT (tf_var)
820   !-------------------------------------------------------------------
821   !> @brief
822   !> This function create variable, filled with matrix value
823   !>
824   !> @details
825   !> A variable is create with the same name that the input variable,
826   !> and with dimension of the coordinate file.<br/>
827   !> Then the variable array of value is split into equal subdomain.
828   !> Each subdomain is filled with the corresponding value of the matrix.
829   !>
830   !> Optionaly, you could add a random value of 0.1% of maximum depth to each
831   !> points of the bathymetry
832   !>
833   !> @author J.Paul
834   !> @date November, 2013 - Initial Version
835   !>
836   !> @param[in] td_var    variable structure
837   !> @param[in] td_coord  coordinate file structure
838   !> @param[in] ld_rand   add random value to bathymetry
839   !> @return variable structure
840   !-------------------------------------------------------------------
841
842      IMPLICIT NONE
843
844      ! Argument
845      TYPE(TVAR), INTENT(IN) :: td_var
846      TYPE(TMPP), INTENT(IN) :: td_coord
847      LOGICAL   , INTENT(IN) :: ld_rand
848
849      ! function
850      TYPE(TVAR)             :: tf_var
851
852      ! local variable
853      INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost
854      INTEGER(i4)      , DIMENSION(2)                    :: il_dim
855      INTEGER(i4)      , DIMENSION(2)                    :: il_size
856      INTEGER(i4)      , DIMENSION(2)                    :: il_rest
857
858      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
859      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_jshape
860
861      REAL(dp)         , DIMENSION(:,:)    , ALLOCATABLE :: dl_ran
862      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
863
864      TYPE(TVAR)                                         :: tl_lon
865      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
866
867      TYPE(TMPP)                                         :: tl_coord
868
869      ! loop indices
870      INTEGER(i4) :: ji
871      INTEGER(i4) :: jj
872      !----------------------------------------------------------------
873
874      ! copy structure
875      tl_coord=mpp_copy(td_coord)
876
877      ! use only edge processor
878      CALL mpp_get_contour(tl_coord)
879
880      ! open useful processor
881      CALL iom_mpp_open(tl_coord)
882
883      ! read output grid
884      tl_lon=iom_mpp_read_var(tl_coord,'longitude')
885
886      ! look for ghost cell
887      il_xghost(:,:)=grid_get_ghost( tl_coord )
888
889      ! close processor
890      CALL iom_mpp_close(tl_coord)
891      ! clean
892      CALL mpp_clean(tl_coord)
893
894      ! remove ghost cell
895      CALL grid_del_ghost(tl_lon, il_xghost(:,:))
896
897      ! write value on grid
898      ! get matrix dimension
899      il_dim(:)=td_var%t_dim(1:2)%i_len
900      ! output dimension
901      tl_dim(:)=dim_copy(tl_lon%t_dim(:))
902      ! clean
903      CALL var_clean(tl_lon)
904
905      ! split output domain in N subdomain depending of matrix dimension
906      il_size(:) = tl_dim(1:2)%i_len / il_dim(:)
907      il_rest(:) = MOD(tl_dim(1:2)%i_len, il_dim(:))
908
909      ALLOCATE( il_ishape(il_dim(1)+1) )
910      il_ishape(:)=0
911      DO ji=2,il_dim(1)+1
912         il_ishape(ji)=il_ishape(ji-1)+il_size(1)
913      ENDDO
914      ! add rest to last cell
915      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1)
916
917      ALLOCATE( il_jshape(il_dim(2)+1) )
918      il_jshape(:)=0
919      DO jj=2,il_dim(2)+1
920         il_jshape(jj)=il_jshape(jj-1)+il_size(2)
921      ENDDO
922      ! add rest to last cell
923      il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2)
924
925      ! write ouput array of value
926      ALLOCATE(dl_value( tl_dim(1)%i_len, &
927      &                  tl_dim(2)%i_len, &
928      &                  tl_dim(3)%i_len, &
929      &                  tl_dim(4)%i_len) )
930
931      dl_value(:,:,:,:)=0
932      DO jj=2,il_dim(2)+1
933         DO ji=2,il_dim(1)+1
934           
935            dl_value( 1+il_ishape(ji-1):il_ishape(ji), &
936            &         1+il_jshape(jj-1):il_jshape(jj), &
937            &         1,1 ) = td_var%d_value(ji-1,jj-1,1,1)
938
939         ENDDO
940      ENDDO
941
942
943      IF( ld_rand )THEN
944         ALLOCATE(dl_ran(tl_dim(1)%i_len, &
945         &               tl_dim(2)%i_len) )
946     
947         ! set random value between 0 and 1
948         CALL RANDOM_NUMBER(dl_ran(:,:))
949         ! set random value between -0.5 and 0.5
950         dl_ran(:,:)=dl_ran(:,:)-0.5
951         ! set random value of 0.1% of maximum depth
952         dl_ran(:,:)=dl_ran(:,:)*1.e-4*MAXVAL(td_var%d_value(:,:,1,1))
953
954         dl_value(:,:,1,1)=dl_value(:,:,1,1)+dl_ran(:,:)
955     
956         DEALLOCATE(dl_ran)
957      ENDIF
958
959      ! initialise variable with value
960      tf_var=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:))
961
962      DEALLOCATE(dl_value)
963
964      ! add ghost cell
965      CALL grid_add_ghost(tf_var, il_xghost(:,:))
966
967      ! clean
968      CALL dim_clean(tl_dim(:))
969
970   END FUNCTION create_bathy_matrix
971   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
972   FUNCTION create_bathy_extract(td_var, td_mpp, td_coord) &
973         &  RESULT (tf_var)
974   !-------------------------------------------------------------------
975   !> @brief
976   !> This function extract variable from file over coordinate domain and
977   !> return variable structure
978   !>
979   !> @author J.Paul
980   !> @date November, 2013 - Initial Version
981   !>
982   !> @param[in] td_var    variable structure
983   !> @param[in] td_mpp    mpp file structure
984   !> @param[in] td_coord  coordinate file structure
985   !> @return variable structure
986   !-------------------------------------------------------------------
987
988      IMPLICIT NONE
989
990      ! Argument
991      TYPE(TVAR), INTENT(IN) :: td_var 
992      TYPE(TMPP), INTENT(IN) :: td_mpp
993      TYPE(TMPP), INTENT(IN) :: td_coord
994
995      ! function
996      TYPE(TVAR)             :: tf_var
997
998      ! local variable
999      INTEGER(i4), DIMENSION(2,2) :: il_ind
1000
1001      INTEGER(i4) :: il_imin
1002      INTEGER(i4) :: il_jmin
1003      INTEGER(i4) :: il_imax
1004      INTEGER(i4) :: il_jmax
1005
1006      TYPE(TMPP)  :: tl_mpp
1007
1008      TYPE(TATT)  :: tl_att
1009
1010      TYPE(TDOM)  :: tl_dom
1011      ! loop indices
1012      !----------------------------------------------------------------
1013
1014      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
1015         CALL logger_error("CREATE BATHY EXTRACT: no processor associated "//&
1016         &  "to mpp "//TRIM(td_mpp%c_name))
1017      ELSE
1018
1019         !init
1020         tl_mpp=mpp_copy(td_mpp)
1021
1022         ! compute file grid indices around coord grid
1023         il_ind(:,:)=grid_get_coarse_index(tl_mpp, td_coord )
1024
1025         il_imin=il_ind(1,1) ; il_imax=il_ind(1,2)
1026         il_jmin=il_ind(2,1) ; il_jmax=il_ind(2,2)
1027
1028         ! check grid coincidence
1029         CALL grid_check_coincidence( tl_mpp, td_coord, &
1030         &                            il_imin, il_imax, &
1031         &                            il_jmin, il_jmax, &
1032         &                            (/1, 1, 1/) )
1033
1034         ! compute domain
1035         tl_dom=dom_init(tl_mpp,           &
1036         &               il_imin, il_imax, &
1037         &               il_jmin, il_jmax)
1038
1039         ! open mpp files over domain
1040         CALL iom_dom_open(tl_mpp, tl_dom)
1041
1042         ! read variable on domain
1043         tf_var=iom_dom_read_var(tl_mpp,TRIM(td_var%c_name),tl_dom)
1044
1045         ! close mpp file
1046         CALL iom_dom_close(tl_mpp)
1047
1048         ! add ghost cell
1049         CALL grid_add_ghost(tf_var,tl_dom%i_ghost(:,:))
1050
1051         ! check result
1052         IF( ANY( tf_var%t_dim(:)%l_use .AND. &
1053         &        tf_var%t_dim(:)%i_len /= td_coord%t_dim(:)%i_len) )THEN
1054            CALL logger_debug("CREATE BATHY EXTRACT: "//&
1055            &        "dimensoin of variable "//TRIM(td_var%c_name)//" "//&
1056            &        TRIM(fct_str(tf_var%t_dim(1)%i_len))//","//&
1057            &        TRIM(fct_str(tf_var%t_dim(2)%i_len))//","//&
1058            &        TRIM(fct_str(tf_var%t_dim(3)%i_len))//","//&
1059            &        TRIM(fct_str(tf_var%t_dim(4)%i_len)) )
1060            CALL logger_debug("CREATE BATHY EXTRACT: "//&
1061            &        "dimensoin of coordinate file "//&
1062            &        TRIM(fct_str(td_coord%t_dim(1)%i_len))//","//&
1063            &        TRIM(fct_str(td_coord%t_dim(2)%i_len))//","//&
1064            &        TRIM(fct_str(td_coord%t_dim(3)%i_len))//","//&
1065            &        TRIM(fct_str(td_coord%t_dim(4)%i_len)) )
1066            CALL logger_fatal("CREATE BATHY EXTRACT: "//&
1067            &  "dimensoin of extracted "//&
1068            &  "variable and coordinate file dimension differ")
1069         ENDIF
1070
1071         ! add attribute to variable
1072         tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
1073         CALL var_move_att(tf_var, tl_att)         
1074
1075         tl_att=att_init('src_i_indices',(/tl_dom%i_imin, tl_dom%i_imax/))
1076         CALL var_move_att(tf_var, tl_att)
1077
1078         tl_att=att_init('src_j_indices',(/tl_dom%i_jmin, tl_dom%i_jmax/))
1079         CALL var_move_att(tf_var, tl_att)
1080
1081         ! clean structure
1082         CALL att_clean(tl_att)
1083         CALL mpp_clean(tl_mpp)
1084      ENDIF
1085
1086   END FUNCTION create_bathy_extract
1087   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1088   FUNCTION create_bathy_get_var(td_var, td_mpp,   &
1089         &                       id_imin, id_jmin, &
1090         &                       id_imax, id_jmax, &
1091         &                       id_offset,        &
1092         &                       id_rho) &
1093         &  RESULT (tf_var)
1094   !-------------------------------------------------------------------
1095   !> @brief
1096   !> This function get coarse grid variable, interpolate variable, and return
1097   !> variable structure over fine grid
1098   !>
1099   !> @author J.Paul
1100   !> @date November, 2013 - Initial Version
1101   !>
1102   !> @param[in] td_var    variable structure
1103   !> @param[in] td_mpp    mpp file structure
1104   !> @param[in] id_imin   i-direction lower left  corner indice
1105   !> @param[in] id_imax   i-direction upper right corner indice
1106   !> @param[in] id_jmin   j-direction lower left  corner indice
1107   !> @param[in] id_jmax   j-direction upper right corner indice
1108   !> @param[in] id_offset offset between fine grid and coarse grid
1109   !> @param[in] id_rho    array of refinement factor
1110   !> @return variable structure
1111   !-------------------------------------------------------------------
1112
1113      IMPLICIT NONE
1114
1115      ! Argument
1116      TYPE(TVAR)                 , INTENT(IN) :: td_var 
1117      TYPE(TMPP)                 , INTENT(IN) :: td_mpp 
1118      INTEGER(i4)                , INTENT(IN) :: id_imin
1119      INTEGER(i4)                , INTENT(IN) :: id_imax
1120      INTEGER(i4)                , INTENT(IN) :: id_jmin
1121      INTEGER(i4)                , INTENT(IN) :: id_jmax
1122      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_offset
1123      INTEGER(i4), DIMENSION(:)  , INTENT(IN) :: id_rho
1124
1125      ! function
1126      TYPE(TVAR)                              :: tf_var
1127
1128      ! local variable
1129      TYPE(TMPP)  :: tl_mpp
1130      TYPE(TATT)  :: tl_att
1131      TYPE(TDOM)  :: tl_dom
1132
1133      INTEGER(i4) :: il_size
1134      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
1135
1136      ! loop indices
1137      !----------------------------------------------------------------
1138      IF( ANY(SHAPE(id_offset(:,:)) /= 2) )THEN
1139         CALL logger_error("CREATE BATHY GET VAR: invalid dimension of "//&
1140         &                 "offset array")
1141      ENDIF
1142
1143      ! copy structure
1144      tl_mpp=mpp_copy(td_mpp)
1145
1146      !- compute domain
1147      tl_dom=dom_init(tl_mpp,           &
1148      &               id_imin, id_imax, &
1149      &               id_jmin, id_jmax)
1150
1151      !- add extra band (if possible) to compute interpolation
1152      CALL dom_add_extra(tl_dom)
1153
1154      !- open mpp files over domain
1155      CALL iom_dom_open(tl_mpp, tl_dom)
1156
1157      !- read variable value on domain
1158      tf_var=iom_dom_read_var(tl_mpp,TRIM(td_var%c_name),tl_dom)
1159
1160      !- close mpp files
1161      CALL iom_dom_close(tl_mpp)
1162
1163      il_size=SIZE(id_rho(:))
1164      ALLOCATE( il_rho(il_size) )
1165      il_rho(:)=id_rho(:)
1166     
1167      !- interpolate variable
1168      CALL create_bathy_interp(tf_var, il_rho(:), id_offset(:,:))
1169
1170      !- remove extraband added to domain
1171      CALL dom_del_extra( tf_var, tl_dom, il_rho(:) )
1172
1173      CALL dom_clean_extra( tl_dom )
1174
1175      !- add ghost cell
1176      CALL grid_add_ghost(tf_var,tl_dom%i_ghost(:,:))
1177 
1178      !- add attribute to variable
1179      tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
1180      CALL var_move_att(tf_var, tl_att)
1181
1182      tl_att=att_init('src_i_indices',(/tl_dom%i_imin, tl_dom%i_imax/))
1183      CALL var_move_att(tf_var, tl_att)
1184
1185      tl_att=att_init('src_j_indices',(/tl_dom%i_jmin, tl_dom%i_jmax/))
1186      CALL var_move_att(tf_var, tl_att)
1187
1188      IF( .NOT. ALL(id_rho(:)==1) )THEN
1189         tl_att=att_init("refinment_factor",(/id_rho(jp_I),id_rho(jp_J)/))
1190         CALL var_move_att(tf_var, tl_att)
1191      ENDIF
1192
1193      DEALLOCATE( il_rho )
1194
1195      !- clean structure
1196      CALL att_clean(tl_att)
1197      CALL mpp_clean(tl_mpp)
1198 
1199   END FUNCTION create_bathy_get_var
1200   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1201   SUBROUTINE create_bathy_interp(td_var, id_rho, id_offset, &
1202         &                        id_iext, id_jext)
1203   !-------------------------------------------------------------------
1204   !> @brief
1205   !> This subroutine interpolate variable
1206   !>
1207   !> @author J.Paul
1208   !> @date November, 2013 - Initial Version
1209   !>
1210   !> @param[inout] td_var variable structure
1211   !> @param[in] id_rho    array of refinment factor
1212   !> @param[in] id_offset array of offset between fine and coarse grid
1213   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext)
1214   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext)
1215   !-------------------------------------------------------------------
1216
1217      IMPLICIT NONE
1218
1219      ! Argument
1220      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
1221      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
1222      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
1223      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
1224      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
1225
1226      ! local variable
1227      TYPE(TVAR)  :: tl_mask
1228
1229      INTEGER(i1), DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
1230
1231      INTEGER(i4) :: il_iext
1232      INTEGER(i4) :: il_jext
1233
1234      ! loop indices
1235      !----------------------------------------------------------------
1236
1237      !WARNING: two extrabands are required for cubic interpolation
1238      il_iext=3
1239      IF( PRESENT(id_iext) ) il_iext=id_iext
1240
1241      il_jext=3
1242      IF( PRESENT(id_jext) ) il_jext=id_jext
1243
1244      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
1245         CALL logger_warn("CREATE BATHY INTERP: at least extrapolation "//&
1246         &  "on two points are required with cubic interpolation ")
1247         il_iext=2
1248      ENDIF
1249
1250      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
1251         CALL logger_warn("CREATE BATHY INTERP: at least extrapolation "//&
1252         &  "on two points are required with cubic interpolation ")
1253         il_jext=2
1254      ENDIF
1255
1256      ! work on mask
1257      ! create mask
1258      ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
1259      &                td_var%t_dim(2)%i_len, &
1260      &                td_var%t_dim(3)%i_len, &
1261      &                td_var%t_dim(4)%i_len) )
1262
1263      bl_mask(:,:,:,:)=1
1264      WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0     
1265
1266      SELECT CASE(TRIM(td_var%c_point))
1267      CASE DEFAULT ! 'T'
1268         tl_mask=var_init('tmask', bl_mask(:,:,:,:), td_dim=td_var%t_dim(:), &
1269         &                id_ew=td_var%i_ew )
1270      CASE('U','V','F')
1271         CALL logger_fatal("CREATE BATHY INTERP: can not computed "//&
1272         &                 "interpolation on "//TRIM(td_var%c_point)//&
1273         &                 " grid point (variable "//TRIM(td_var%c_name)//&
1274         &                 "). check namelist.")
1275      END SELECT
1276
1277      DEALLOCATE(bl_mask)
1278
1279      ! interpolate mask
1280      CALL interp_fill_value( tl_mask, id_rho(:), &
1281      &                       id_offset=id_offset(:,:) )
1282
1283      ! work on variable
1284      ! add extraband
1285      CALL extrap_add_extrabands(td_var, il_iext, il_jext)
1286
1287      ! extrapolate variable
1288      CALL extrap_fill_value( td_var )
1289
1290      ! interpolate Bathymetry
1291      CALL interp_fill_value( td_var, id_rho(:), &
1292      &                       id_offset=id_offset(:,:) )
1293
1294      ! remove extraband
1295      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
1296
1297      ! keep original mask
1298      WHERE( tl_mask%d_value(:,:,:,:) == 0 )
1299         td_var%d_value(:,:,:,:)=td_var%d_fill
1300      END WHERE
1301
1302      ! clean variable structure
1303      CALL var_clean(tl_mask)
1304
1305   END SUBROUTINE create_bathy_interp
1306   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1307   SUBROUTINE create_bathy_check_depth(td_mpp, td_depth)
1308   !-------------------------------------------------------------------
1309   !> @brief
1310   !> This subroutine get depth variable value in an open mpp structure
1311   !> and check if agree with already input depth variable.
1312   !>
1313   !> @details
1314   !>
1315   !> @author J.Paul
1316   !> @date January, 2016 - Initial Version
1317   !>
1318   !> @param[in] td_mpp       mpp structure
1319   !> @param[inout] td_depth  depth variable structure
1320   !-------------------------------------------------------------------
1321
1322      IMPLICIT NONE
1323
1324      ! Argument
1325      TYPE(TMPP) , INTENT(IN   ) :: td_mpp
1326      TYPE(TVAR) , INTENT(INOUT) :: td_depth
1327
1328      ! local variable
1329      INTEGER(i4) :: il_varid
1330      TYPE(TVAR)  :: tl_depth
1331      ! loop indices
1332      !----------------------------------------------------------------
1333
1334      ! get or check depth value
1335      IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
1336
1337         il_varid=td_mpp%t_proc(1)%i_depthid
1338         IF( ASSOCIATED(td_depth%d_value) )THEN
1339
1340            tl_depth=iom_mpp_read_var(td_mpp, il_varid)
1341
1342            IF( ANY( td_depth%d_value(:,:,:,:) /= &
1343            &        tl_depth%d_value(:,:,:,:) ) )THEN
1344
1345               CALL logger_warn("CREATE BATHY: depth value from "//&
1346               &  TRIM(td_mpp%c_name)//" not conform "//&
1347               &  " to those from former file(s).")
1348
1349            ENDIF
1350            CALL var_clean(tl_depth)
1351
1352         ELSE
1353            td_depth=iom_mpp_read_var(td_mpp,il_varid)
1354         ENDIF
1355
1356      ENDIF
1357     
1358   END SUBROUTINE create_bathy_check_depth
1359   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1360   SUBROUTINE create_bathy_check_time(td_mpp, td_time)
1361   !-------------------------------------------------------------------
1362   !> @brief
1363   !> This subroutine get date and time in an open mpp structure
1364   !> and check if agree with date and time already read.
1365   !>
1366   !> @details
1367   !>
1368   !> @author J.Paul
1369   !> @date January, 2016 - Initial Version
1370   !>
1371   !> @param[in] td_mpp      mpp structure
1372   !> @param[inout] td_time  time variable structure
1373   !-------------------------------------------------------------------
1374
1375      IMPLICIT NONE
1376
1377      ! Argument
1378      TYPE(TMPP), INTENT(IN   ) :: td_mpp
1379      TYPE(TVAR), INTENT(INOUT) :: td_time
1380
1381      ! local variable
1382      INTEGER(i4) :: il_varid
1383      TYPE(TVAR)  :: tl_time
1384
1385      TYPE(TDATE) :: tl_date1
1386      TYPE(TDATE) :: tl_date2
1387      ! loop indices
1388      !----------------------------------------------------------------
1389
1390      ! get or check depth value
1391      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
1392
1393         il_varid=td_mpp%t_proc(1)%i_timeid
1394         IF( ASSOCIATED(td_time%d_value) )THEN
1395
1396            tl_time=iom_mpp_read_var(td_mpp, il_varid)
1397
1398            tl_date1=var_to_date(td_time)
1399            tl_date2=var_to_date(tl_time)
1400            IF( tl_date1 - tl_date2 /= 0 )THEN
1401
1402               CALL logger_warn("CREATE BATHY: date from "//&
1403               &  TRIM(td_mpp%c_name)//" not conform "//&
1404               &  " to those from former file(s).")
1405
1406            ENDIF
1407            CALL var_clean(tl_time)
1408
1409         ELSE
1410            td_time=iom_mpp_read_var(td_mpp,il_varid)
1411         ENDIF
1412
1413      ENDIF
1414     
1415   END SUBROUTINE create_bathy_check_time
1416   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1417END PROGRAM create_bathy
Note: See TracBrowser for help on using the repository browser.