Ignore:
Timestamp:
2015-07-15T17:46:12+02:00 (5 years ago)
Author:
andrewryan
Message:

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90

    r4213 r5600  
    33!---------------------------------------------------------------------- 
    44! 
    5 ! 
    65! PROGRAM: create_bathy 
    76! 
    87! DESCRIPTION: 
     8!> @file 
    99!> @brief  
    10 !> This program create bathymetry file. 
     10!> This program create fine grid bathymetry file. 
    1111!> 
    1212!> @details 
    13 !> Bathymetry could be extracted from fine grid Bathymetry file, or interpolated 
    14 !> from coarse grid Bathymetry file. 
    15 !> 
    16 !> @author 
    17 !> J.Paul 
     13!> @section sec1 method 
     14!> Bathymetry could be extracted from fine grid Bathymetry file, interpolated 
     15!> from coarse grid Bathymetry file, or manually written. 
     16!> 
     17!> @section sec2 how to 
     18!>    to create fine grid bathymetry file:<br/> 
     19!> @code{.sh} 
     20!>    ./SIREN/bin/create_bathy create_bathy.nam 
     21!> @endcode 
     22!>     
     23!>    create_bathy.nam comprise 7 namelists:<br/> 
     24!>       - logger namelist (namlog) 
     25!>       - config namelist (namcfg) 
     26!>       - coarse grid namelist (namcrs) 
     27!>       - fine grid namelist (namfin) 
     28!>       - variable namelist (namvar) 
     29!>       - nesting namelist (namnst) 
     30!>       - output namelist (namout) 
     31!>     
     32!>    @note  
     33!>       All namelists have to be in file create_bathy.nam, however variables of 
     34!>       those namelists are all optional. 
     35!> 
     36!>    * _logger namelist (namlog)_:<br/> 
     37!>       - cn_logfile   : log filename 
     38!>       - cn_verbosity : verbosity ('trace','debug','info', 
     39!> 'warning','error','fatal') 
     40!>       - in_maxerror  : maximum number of error allowed 
     41!> 
     42!>    * _config namelist (namcfg)_:<br/> 
     43!>       - cn_varcfg : variable configuration file  
     44!> (see ./SIREN/cfg/variable.cfg) 
     45!> 
     46!>    * _coarse grid namelist (namcrs)_:<br/> 
     47!>       - cn_coord0 : coordinate file 
     48!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in 
     49!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals)) 
     50!> 
     51!>    * _fine grid namelist (namfin)_:<br/> 
     52!>       - cn_coord1 : coordinate file 
     53!>       - in_perio1 : periodicity index 
     54!>       - ln_fillclosed : fill closed sea or not 
     55!> 
     56!>    * _variable namelist (namvar)_:<br/> 
     57!>       - cn_varinfo : list of variable and extra information about request(s)  
     58!>       to be used.<br/> 
     59!>          each elements of *cn_varinfo* is a string character.<br/> 
     60!>          it is composed of the variable name follow by ':',  
     61!>          then request(s) to be used on this variable.<br/>  
     62!>          request could be: 
     63!>             - interpolation method 
     64!>             - extrapolation method 
     65!>             - filter method 
     66!>             - > minimum value 
     67!>             - < maximum value 
     68!> 
     69!>                requests must be separated by ';'.<br/> 
     70!>                order of requests does not matter.<br/> 
     71!> 
     72!>          informations about available method could be find in @ref interp, 
     73!>          @ref extrap and @ref filter modules.<br/> 
     74!>          Example: 'Bathymetry: 2*hamming(2,3); > 0' 
     75!>          @note  
     76!>             If you do not specify a method which is required,  
     77!>             default one is apply. 
     78!>          @warning  
     79!>             variable name must be __Bathymetry__ here. 
     80!>       - cn_varfile : list of variable, and corresponding file.<br/>  
     81!>          *cn_varfile* is the path and filename of the file where find 
     82!>          variable. 
     83!>          @note  
     84!>             *cn_varfile* could be a matrix of value, if you want to filled 
     85!>             manually variable value.<br/> 
     86!>             the variable array of value is split into equal subdomain.<br/> 
     87!>             Each subdomain is filled with the corresponding value  
     88!>             of the matrix.<br/>           
     89!>             separators used to defined matrix are: 
     90!>                - ',' for line 
     91!>                - '/' for row 
     92!>                - '\' for level<br/> 
     93!>                Example:<br/> 
     94!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc} 
     95!>                                         3 & 2 & 3 \\ 
     96!>                                         1 & 4 & 5 \end{array} \right) @f$ 
     97!> 
     98!>          Examples:  
     99!>             - 'Bathymetry:gridT.nc' 
     100!>             - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000' 
     101!> 
     102!>          \image html  bathy_40.png  
     103!>          \image latex bathy_30.png 
     104!> 
     105!>    * _nesting namelist (namnst)_:<br/> 
     106!>       - in_rhoi  : refinement factor in i-direction 
     107!>       - in_rhoj  : refinement factor in j-direction 
     108!>       @note  
     109!>          coarse grid indices will be deduced from fine grid 
     110!>          coordinate file. 
     111!> 
     112!>    * _output namelist (namout)_:<br/> 
     113!>       - cn_fileout : output bathymetry file 
     114!> 
     115!> @author J.Paul 
    18116! REVISION HISTORY: 
    19 !> @date Nov, 2013 - Initial Version 
     117!> @date November, 2013 - Initial Version 
     118!> @date Sepember, 2014  
     119!> - add header for user 
     120!> - Bug fix, compute offset depending of grid point 
    20121! 
    21122!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    22 !> 
    23 !> @todo 
    24 !> - add attributes indices and refinement in output file 
    25123!---------------------------------------------------------------------- 
    26 !> @code 
    27124PROGRAM create_bathy 
    28125 
    29 !   USE netcdf                          ! nf90 library 
    30126   USE global                          ! global variable 
    31127   USE kind                            ! F90 kind parameter 
     
    39135   USE multi                           ! multi file manager 
    40136   USE iom                             ! I/O manager 
    41    USE dom                             ! domain manager 
    42137   USE grid                            ! grid manager 
    43138   USE extrap                          ! extrapolation manager 
     
    45140   USE filter                          ! filter manager 
    46141   USE mpp                             ! MPP manager 
     142   USE dom                             ! domain manager 
    47143   USE iom_mpp                         ! MPP I/O manager 
     144   USE iom_dom                         ! DOM I/O manager 
    48145 
    49146   IMPLICIT NONE 
     
    57154   INTEGER(i4)                                        :: il_status 
    58155   INTEGER(i4)                                        :: il_fileid 
     156   INTEGER(i4)                                        :: il_varid 
    59157   INTEGER(i4)                                        :: il_attid 
    60    INTEGER(i4)                                        :: il_imin 
    61    INTEGER(i4)                                        :: il_imax 
    62    INTEGER(i4)                                        :: il_jmin 
    63    INTEGER(i4)                                        :: il_jmax 
     158   INTEGER(i4)                                        :: il_imin0 
     159   INTEGER(i4)                                        :: il_imax0 
     160   INTEGER(i4)                                        :: il_jmin0 
     161   INTEGER(i4)                                        :: il_jmax0 
    64162   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho 
    65163   INTEGER(i4)      , DIMENSION(2,2)                  :: il_offset 
    66    INTEGER(i4)      , DIMENSION(2,2,2)                :: il_ind 
     164   INTEGER(i4)      , DIMENSION(2,2                :: il_ind 
    67165   INTEGER(i4)      , DIMENSION(:,:)    , ALLOCATABLE :: il_mask 
    68166 
    69167   LOGICAL                                            :: ll_exist 
    70168 
    71    TYPE(TFILE)                                        :: tl_coord0 
    72    TYPE(TFILE)                                        :: tl_coord1 
    73    TYPE(TFILE)                                        :: tl_file 
     169   TYPE(TMPP)                                         :: tl_coord0 
     170   TYPE(TMPP)                                         :: tl_coord1 
     171   TYPE(TMPP)                                         :: tl_mpp 
    74172   TYPE(TFILE)                                        :: tl_fileout 
    75173 
     
    88186   TYPE(TMULTI)                                       :: tl_multi 
    89187 
     188   REAL(dp)                                           :: dl_minbat 
     189 
    90190   ! loop indices 
    91191   INTEGER(i4) :: ji 
     
    94194 
    95195   ! namelist variable 
     196   ! namlog 
    96197   CHARACTER(LEN=lc) :: cn_logfile = 'create_bathy.log'  
    97198   CHARACTER(LEN=lc) :: cn_verbosity = 'warning'  
    98  
     199   INTEGER(i4)       :: in_maxerror = 5 
     200 
     201   ! namcfg 
    99202   CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg'  
    100203 
     204   ! namcrs 
    101205   CHARACTER(LEN=lc) :: cn_coord0 = ''  
    102206   INTEGER(i4)       :: in_perio0 = -1 
    103207 
     208   ! namfin 
    104209   CHARACTER(LEN=lc) :: cn_coord1 = '' 
    105210   INTEGER(i4)       :: in_perio1 = -1 
    106211   LOGICAL           :: ln_fillclosed = .TRUE. 
    107212 
    108    CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varinfo = '' 
    109    CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varfile = '' 
    110  
    111    INTEGER(i4)       :: in_imin0 = 0 
    112    INTEGER(i4)       :: in_imax0 = 0 
    113    INTEGER(i4)       :: in_jmin0 = 0 
    114    INTEGER(i4)       :: in_jmax0 = 0 
     213   ! namvar 
     214   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
     215   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
     216 
     217   ! namnst 
    115218   INTEGER(i4)       :: in_rhoi  = 1 
    116219   INTEGER(i4)       :: in_rhoj  = 1 
    117220 
     221   ! namout 
    118222   CHARACTER(LEN=lc) :: cn_fileout = 'bathy_fine.nc'  
    119223   !------------------------------------------------------------------- 
    120224 
    121    NAMELIST /namlog/ &  !< logger namelist 
    122    &  cn_logfile,    &  !< log file 
    123    &  cn_verbosity      !< log verbosity 
    124  
    125    NAMELIST /namcfg/ &  !< configuration namelist 
    126    &  cn_varcfg         !< variable configuration file 
     225   NAMELIST /namlog/ &   !< logger namelist 
     226   &  cn_logfile,    &   !< log file 
     227   &  cn_verbosity,  &   !< log verbosity 
     228   &  in_maxerror        !< logger maximum error 
     229 
     230   NAMELIST /namcfg/ &   !< configuration namelist 
     231   &  cn_varcfg          !< variable configuration file 
    127232 
    128233   NAMELIST /namcrs/ &   !< coarse grid namelist 
     
    135240   &  ln_fillclosed      !< fill closed sea 
    136241  
    137    NAMELIST /namvar/ &  !< variable namelist 
    138    &  cn_varinfo, &     !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' ) 
    139    &  cn_varfile        !< list of variable file 
     242   NAMELIST /namvar/ &   !< variable namelist 
     243   &  cn_varinfo, &      !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' ) 
     244   &  cn_varfile         !< list of variable file 
    140245    
    141    NAMELIST /namnst/ &  !< nesting namelist 
    142    &  in_imin0,   &     !< i-direction lower left  point indice  
    143    &  in_imax0,   &     !< i-direction upper right point indice 
    144    &  in_jmin0,   &     !< j-direction lower left  point indice 
    145    &  in_jmax0,   &     !< j-direction upper right point indice 
    146    &  in_rhoi,    &     !< refinement factor in i-direction 
    147    &  in_rhoj           !< refinement factor in j-direction 
    148  
    149    NAMELIST /namout/ &  !< output namlist 
    150    &  cn_fileout       !< fine grid bathymetry file 
     246   NAMELIST /namnst/ &   !< nesting namelist 
     247   &  in_rhoi,    &      !< refinement factor in i-direction 
     248   &  in_rhoj            !< refinement factor in j-direction 
     249 
     250   NAMELIST /namout/ &   !< output namlist 
     251   &  cn_fileout         !< fine grid bathymetry file 
    151252   !------------------------------------------------------------------- 
    152253 
    153    !1- namelist 
    154    !1-1 get namelist 
     254   ! namelist 
     255   ! get namelist 
    155256   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec 
    156257   IF( il_narg/=1 )THEN 
     
    160261      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec 
    161262   ENDIF 
    162     
    163    !1-2 read namelist 
     263  
     264   ! read namelist 
    164265   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 
    165266   IF( ll_exist )THEN 
    166        
     267  
    167268      il_fileid=fct_getunit() 
    168269 
     
    180281 
    181282      READ( il_fileid, NML = namlog ) 
    182       !1-2-1 define log file 
    183       CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity)) 
     283      ! define log file 
     284      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror) 
    184285      CALL logger_header() 
    185286 
    186287      READ( il_fileid, NML = namcfg ) 
    187       !1-2-2 get variable extra information 
     288      ! get variable extra information 
    188289      CALL var_def_extra(TRIM(cn_varcfg)) 
    189290 
     
    191292      READ( il_fileid, NML = namfin ) 
    192293      READ( il_fileid, NML = namvar ) 
    193       !1-2-3 add user change in extra information 
    194       CALL var_chg_extra(cn_varinfo) 
    195       !1-2-4 match variable with file 
     294      ! add user change in extra information 
     295      CALL var_chg_extra( cn_varinfo ) 
     296      ! match variable with file 
    196297      tl_multi=multi_init(cn_varfile) 
    197298       
     
    211312   ENDIF 
    212313 
    213    !2- open files 
     314   CALL multi_print(tl_multi) 
     315 
     316   ! open files 
    214317   IF( cn_coord0 /= '' )THEN 
    215       tl_coord0=file_init(TRIM(cn_coord0),id_perio=in_perio0) 
    216       CALL iom_open(tl_coord0) 
     318      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0) 
     319      CALL grid_get_info(tl_coord0) 
    217320   ELSE 
    218321      CALL logger_fatal("CREATE BATHY: no coarse grid coordinate found. "//& 
     
    221324 
    222325   IF( TRIM(cn_coord1) /= '' )THEN 
    223       tl_coord1=file_init(TRIM(cn_coord1),id_perio=in_perio1) 
    224       CALL iom_open(tl_coord1) 
     326      tl_coord1=mpp_init( file_init(TRIM(cn_coord1)),id_perio=in_perio1) 
     327      CALL grid_get_info(tl_coord1) 
    225328   ELSE 
    226329      CALL logger_fatal("CREATE BATHY: no fine grid coordinate found. "//& 
     
    228331   ENDIF 
    229332 
    230    !3- check 
    231    !3-1 check output file do not already exist 
     333   ! check 
     334   ! check output file do not already exist 
    232335   INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist) 
    233336   IF( ll_exist )THEN 
     
    236339   ENDIF 
    237340 
    238    !3-2 check namelist 
    239    !3-2-1 check refinement factor 
     341   ! check namelist 
     342   ! check refinement factor 
    240343   il_rho(:)=1 
    241344   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN 
     
    247350   ENDIF 
    248351 
    249    !3-2-2 check domain indices 
    250    IF( in_imin0 < 1 .OR. in_imax0 < 1 .OR. & 
    251    &   in_jmin0 < 1 .OR. in_jmax0 < 1)THEN 
    252       ! compute coarse grid indices around fine grid 
    253       IF( cn_coord0 /= '' )THEN 
    254          il_ind(:,:,:)=grid_get_coarse_index( tl_coord0, tl_coord1, & 
    255          &                                    id_rho=il_rho(:) ) 
    256       ENDIF 
    257  
    258       il_imin=il_ind(1,1,1) ; il_imax=il_ind(1,2,1) 
    259       il_jmin=il_ind(2,1,1) ; il_jmax=il_ind(2,2,1) 
    260  
    261       il_offset(:,:)=il_ind(:,:,2) 
    262    ELSE 
    263       il_imin=in_imin0 ; il_imax=in_imax0 
    264       il_jmin=in_jmin0 ; il_jmax=in_jmax0 
    265  
    266       il_offset(jp_I,:)=FLOOR(REAL(il_rho(jp_I)-1,dp)*0.5) 
    267       il_offset(jp_J,:)=FLOOR(REAL(il_rho(jp_J)-1,dp)*0.5) 
    268    ENDIF 
    269  
    270    !3-2-3 check domain validity 
    271    IF( cn_coord0 /= '' )THEN 
    272       CALL grid_check_dom(tl_coord0, il_imin, il_imax, il_jmin, il_jmax) 
    273    ENDIF 
    274  
    275    !3-2-4 check coincidence between coarse and fine grid 
    276    IF( cn_coord0 /= '' )THEN 
    277       CALL grid_check_coincidence( tl_coord0, tl_coord1, & 
    278       &                            il_imin, il_imax, & 
    279       &                            il_jmin, il_jmax, & 
    280       &                            il_rho(:) ) 
    281    ENDIF 
    282  
    283    IF( .NOT. ASSOCIATED(tl_multi%t_file) )THEN 
    284       CALL logger_error("CREATE BATHY: no file to work on. "//& 
     352   ! check domain indices 
     353   ! compute coarse grid indices around fine grid 
     354   il_ind(:,:)=grid_get_coarse_index( tl_coord0, tl_coord1, & 
     355   &                                  id_rho=il_rho(:) ) 
     356 
     357   il_imin0=il_ind(jp_I,1) ; il_imax0=il_ind(jp_I,2) 
     358   il_jmin0=il_ind(jp_J,1) ; il_jmax0=il_ind(jp_J,2) 
     359 
     360   ! check domain validity 
     361   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0) 
     362 
     363   ! check coincidence between coarse and fine grid 
     364   CALL grid_check_coincidence( tl_coord0, tl_coord1, & 
     365   &                            il_imin0, il_imax0, & 
     366   &                            il_jmin0, il_jmax0, & 
     367   &                            il_rho(:) ) 
     368 
     369   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN 
     370      CALL logger_error("CREATE BATHY: no mpp file to work on. "//& 
    285371      &                 "check cn_varfile in namelist.") 
    286372   ELSE 
     373 
    287374      ALLOCATE( tl_var( tl_multi%i_nvar ) ) 
    288375      jk=0 
    289       DO ji=1,tl_multi%i_nfile 
    290          WRITE(cl_data,'(a,i2.2)') 'data_',jk+1 
    291          IF( .NOT. ASSOCIATED(tl_multi%t_file(ji)%t_var) )THEN 
    292             CALL logger_error("CREATE BATHY: no variable to work on for "//& 
    293             &                 "file"//TRIM(tl_multi%t_file(ji)%c_name)//& 
     376      DO ji=1,tl_multi%i_nmpp 
     377       
     378         WRITE(cl_data,'(a,i2.2)') 'data-',jk+1 
     379         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN 
     380 
     381            CALL logger_fatal("CREATE BATHY: no variable to work on for "//& 
     382            &                 "mpp file"//TRIM(tl_multi%t_mpp(ji)%c_name)//& 
    294383            &                 ". check cn_varfile in namelist.") 
    295          ELSEIF( TRIM(tl_multi%t_file(ji)%c_name) == TRIM(cl_data) )THEN 
    296             DO jj=1,tl_multi%t_file(ji)%i_nvar 
     384 
     385         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN 
     386 
     387            !- use input matrix to initialise variable 
     388            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    297389               jk=jk+1 
    298                tl_tmp=tl_multi%t_file(ji)%t_var(jj) 
    299                !- use input matrix to initialise variable 
     390               tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 
     391             
    300392               tl_var(jk)=create_bathy_matrix(tl_tmp, tl_coord1) 
    301393            ENDDO 
     394            ! clean 
     395            CALL var_clean(tl_tmp) 
     396 
    302397         ELSE 
    303             ! open file 
    304             tl_file=file_init(TRIM(tl_multi%t_file(ji)%c_name)) 
    305             CALL iom_open(tl_file) 
     398 
     399            tl_mpp=mpp_init( file_init(TRIM(tl_multi%t_mpp(ji)%c_name)) ) 
     400            CALL grid_get_info(tl_mpp) 
     401 
     402            ! open mpp file 
     403            CALL iom_mpp_open(tl_mpp) 
    306404 
    307405            ! get or check depth value 
    308             IF( tl_file%i_depthid /= 0 )THEN 
     406            IF( tl_multi%t_mpp(ji)%t_proc(1)%i_depthid /= 0 )THEN 
     407               il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_depthid 
    309408               IF( ASSOCIATED(tl_depth%d_value) )THEN 
     409                  tl_tmp=iom_mpp_read_var(tl_mpp,il_varid) 
    310410                  IF( ANY( tl_depth%d_value(:,:,:,:) /= & 
    311411                  &        tl_tmp%d_value(:,:,:,:) ) )THEN 
    312412                     CALL logger_fatal("CREATE BATHY: depth value from "//& 
    313                      &  TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& 
     413                     &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
    314414                     &  " to those from former file(s).") 
    315415                  ENDIF 
     416                  CALL var_clean(tl_tmp) 
    316417               ELSE 
    317                   tl_depth=iom_read_var(tl_file,tl_file%i_depthid) 
     418                  tl_depth=iom_mpp_read_var(tl_mpp,il_varid) 
    318419               ENDIF 
    319420            ENDIF 
    320421 
    321422            ! get or check time value 
    322             IF( tl_file%i_timeid /= 0 )THEN 
     423            IF( tl_multi%t_mpp(ji)%t_proc(1)%i_timeid /= 0 )THEN 
     424               il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_timeid 
    323425               IF( ASSOCIATED(tl_time%d_value) )THEN 
     426                  tl_tmp=iom_mpp_read_var(tl_mpp,il_varid) 
    324427                  IF( ANY( tl_time%d_value(:,:,:,:) /= & 
    325428                  &        tl_tmp%d_value(:,:,:,:) ) )THEN 
    326429                     CALL logger_fatal("CREATE BATHY: time value from "//& 
    327                      &  TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& 
     430                     &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
    328431                     &  " to those from former file(s).") 
    329432                  ENDIF 
     433                  CALL var_clean(tl_tmp) 
    330434               ELSE 
    331                   tl_time=iom_read_var(tl_file,tl_file%i_timeid) 
     435                  tl_time=iom_mpp_read_var(tl_mpp,il_varid) 
    332436               ENDIF 
    333437            ENDIF 
    334438 
    335             IF( ANY( tl_file%t_dim(1:2)%i_len /= & 
    336             &      tl_coord0%t_dim(1:2)%i_len) )THEN 
    337                DO jj=1,tl_multi%t_file(ji)%i_nvar 
     439            ! close mpp file 
     440            CALL iom_mpp_close(tl_mpp) 
     441 
     442            IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 
     443            &        tl_coord0%t_dim(1:2)%i_len) )THEN 
     444               !- extract bathymetry from fine grid bathymetry  
     445               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    338446                  jk=jk+1 
    339                   tl_tmp=tl_multi%t_file(ji)%t_var(jj) 
    340                   !- extract bathymetry from fine grid bathymetry  
    341                   tl_var(jk)=create_bathy_extract( tl_tmp, tl_file, & 
     447                  tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 
     448                
     449                  tl_var(jk)=create_bathy_extract( tl_tmp, tl_mpp, & 
    342450                  &                                tl_coord1 ) 
    343451               ENDDO 
     452               ! clean 
     453               CALL var_clean(tl_tmp) 
    344454            ELSE 
    345                DO jj=1,tl_multi%t_file(ji)%i_nvar 
     455               !- get bathymetry from coarse grid bathymetry  
     456               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    346457                  jk=jk+1 
    347                   tl_tmp=tl_multi%t_file(ji)%t_var(jj) 
    348                   !- get bathymetry from coarse grid bathymetry  
    349                   tl_var(jk)=create_bathy_get_var( tl_tmp, tl_file,  & 
    350                   &                                il_imin, il_jmin, & 
    351                   &                                il_imax, il_jmax, & 
    352                   &                                il_offset(:,:),   & 
     458                  tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 
     459 
     460                  il_offset(:,:)= grid_get_fine_offset(tl_coord0,    & 
     461                  &                                    il_imin0, il_jmin0, & 
     462                  &                                    il_imax0, il_jmax0, & 
     463                  &                                    tl_coord1,          & 
     464                  &                                    il_rho(:),          & 
     465                  &                                    TRIM(tl_tmp%c_point) ) 
     466 
     467                  tl_var(jk)=create_bathy_get_var( tl_tmp, tl_mpp,     & 
     468                  &                                il_imin0, il_jmin0, & 
     469                  &                                il_imax0, il_jmax0, & 
     470                  &                                il_offset(:,:),  & 
    353471                  &                                il_rho(:) ) 
    354472               ENDDO 
     473               ! clean 
     474               CALL var_clean(tl_tmp) 
    355475            ENDIF 
    356476 
    357             ! close file 
    358             CALL iom_close(tl_file) 
    359477            ! clean structure 
    360             CALL file_clean(tl_file) 
     478            CALL mpp_clean(tl_mpp) 
     479 
    361480         ENDIF 
    362481      ENDDO 
     
    364483 
    365484   DO jk=1,tl_multi%i_nvar 
    366          !6- forced min and max value 
     485         ! forced min and max value 
    367486         CALL var_limit_value(tl_var(jk)) 
    368487 
    369          !7- fill closed sea 
    370          IF( TRIM(tl_var(jk)%c_stdname) == 'bathymetry' .AND. & 
    371              ln_fillclosed )THEN 
     488         ! fill closed sea 
     489         IF( ln_fillclosed )THEN 
    372490            ALLOCATE( il_mask(tl_var(jk)%t_dim(1)%i_len, & 
    373491            &                 tl_var(jk)%t_dim(2)%i_len) ) 
    374492 
    375             !7-1 split domain in N sea subdomain 
     493            ! split domain in N sea subdomain 
    376494            il_mask(:,:)=grid_split_domain(tl_var(jk)) 
    377495 
    378             !7-2  fill smallest domain 
     496            !  fill smallest domain 
    379497            CALL grid_fill_small_dom( tl_var(jk), il_mask(:,:) ) 
    380498 
     
    382500         ENDIF 
    383501 
    384          !8- filter 
     502         ! filter 
    385503         CALL filter_fill_value(tl_var(jk)) 
    386504 
    387          !9- check bathymetry 
     505         ! check bathymetry 
     506         dl_minbat=MINVAL(tl_var(jk)%d_value(:,:,:,:)) 
    388507         IF( TRIM(tl_var(jk)%c_stdname) == 'bathymetry' .AND. & 
    389          &   MINVAL(tl_var(jk)%d_value(:,:,:,:)) <= 0._dp  )THEN 
     508         &   dl_minbat <= 0._dp  )THEN 
     509            CALL logger_debug("CREATE BATHY: min value "//TRIM(fct_str(dl_minbat))) 
    390510            CALL logger_error("CREATE BATHY: Bathymetry has value <= 0") 
    391511         ENDIF 
     512 
    392513   ENDDO 
    393514 
    394  
    395    !10- create file 
    396    tl_fileout=file_init(TRIM(cn_fileout),id_perio=in_perio1) 
    397  
    398    !10-1 add dimension 
     515   ! create file 
     516   tl_fileout=file_init(TRIM(cn_fileout)) 
     517 
     518   ! add dimension 
    399519   tl_dim(:)=var_max_dim(tl_var(:)) 
    400520 
     
    403523   ENDDO 
    404524 
    405    !10-2 add variables 
     525   ! add variables 
    406526   IF( ALL( tl_dim(1:2)%l_use ) )THEN 
    407527 
     528      ! open mpp files 
     529      CALL iom_mpp_open(tl_coord1) 
     530 
    408531      ! add longitude 
    409       tl_lon=iom_read_var(tl_coord1,'longitude') 
     532      tl_lon=iom_mpp_read_var(tl_coord1,'longitude') 
    410533      CALL file_add_var(tl_fileout, tl_lon) 
    411534      CALL var_clean(tl_lon) 
    412535 
    413536      ! add latitude 
    414       tl_lat=iom_read_var(tl_coord1,'latitude') 
     537      tl_lat=iom_mpp_read_var(tl_coord1,'latitude') 
    415538      CALL file_add_var(tl_fileout, tl_lat) 
    416539      CALL var_clean(tl_lat) 
     540 
     541      ! close mpp files 
     542      CALL iom_mpp_close(tl_coord1) 
    417543 
    418544   ENDIF 
     
    435561      CALL var_clean(tl_var(jk)) 
    436562   ENDDO 
    437  
    438    !10-3 add some attribute 
     563   DEALLOCATE(tl_var) 
     564 
     565   ! add some attribute 
    439566   tl_att=att_init("Created_by","SIREN create_bathy") 
    440567   CALL file_add_att(tl_fileout, tl_att) 
     
    447574   il_attid=0 
    448575   IF( ASSOCIATED(tl_fileout%t_att) )THEN 
    449       il_attid=att_get_id(tl_fileout%t_att(:),'periodicity') 
     576      il_attid=att_get_index(tl_fileout%t_att(:),'periodicity') 
    450577   ENDIF 
    451578   IF( tl_coord1%i_perio >= 0 .AND. il_attid == 0 )THEN 
     
    454581   ENDIF 
    455582 
     583   ! add attribute east west overlap 
    456584   il_attid=0 
    457585   IF( ASSOCIATED(tl_fileout%t_att) )THEN 
    458       il_attid=att_get_id(tl_fileout%t_att(:),'ew_overlap') 
     586      il_attid=att_get_index(tl_fileout%t_att(:),'ew_overlap') 
    459587   ENDIF 
    460588   IF( tl_coord1%i_ew >= 0 .AND. il_attid == 0 )THEN 
     
    462590      CALL file_add_att(tl_fileout,tl_att) 
    463591   ENDIF 
    464  
    465    !10-4 create file 
     592    
     593   ! create file 
    466594   CALL iom_create(tl_fileout) 
    467595 
    468    !10-5 write file 
     596   ! write file 
    469597   CALL iom_write_file(tl_fileout) 
    470598 
    471    !10-6 close file 
     599   ! close file 
    472600   CALL iom_close(tl_fileout) 
    473    IF( cn_coord0 /= '' ) CALL iom_close(tl_coord0) 
    474  
    475    !11- clean 
    476    DEALLOCATE(tl_var) 
     601 
     602   ! clean 
     603   CALL att_clean(tl_att) 
    477604 
    478605   CALL file_clean(tl_fileout) 
    479    CALL file_clean(tl_coord1) 
    480    CALL file_clean(tl_coord0) 
     606   CALL mpp_clean(tl_coord1) 
     607   CALL mpp_clean(tl_coord0) 
    481608 
    482609   ! close log file 
     
    484611   CALL logger_close() 
    485612 
    486 !> @endcode 
    487613CONTAINS 
    488614   !------------------------------------------------------------------- 
    489615   !> @brief 
    490    !> This subroutine 
     616   !> This function create variable, filled with matrix value 
    491617   !>  
    492618   !> @details  
     619   !> A variable is create with the same name that the input variable,  
     620   !> and with dimension of the coordinate file.<br/>  
     621   !> Then the variable array of value is split into equal subdomain. 
     622   !> Each subdomain is filled with the corresponding value of the matrix. 
    493623   !> 
    494624   !> @author J.Paul 
    495    !> - Nov, 2013- Initial Version 
     625   !> - November, 2013- Initial Version 
    496626   !> 
    497    !> @param[in]  
     627   !> @param[in] td_var    variable structure  
     628   !> @param[in] td_coord  coordinate file structure 
     629   !> @return variable structure 
    498630   !------------------------------------------------------------------- 
    499    !> @code 
    500631   FUNCTION create_bathy_matrix(td_var, td_coord) 
    501632      IMPLICIT NONE 
    502633      ! Argument 
    503       TYPE(TVAR) , INTENT(IN) :: td_var 
    504       TYPE(TFILE), INTENT(IN) :: td_coord 
     634      TYPE(TVAR), INTENT(IN) :: td_var 
     635      TYPE(TMPP), INTENT(IN) :: td_coord 
    505636 
    506637      ! function 
     
    508639 
    509640      ! local variable 
    510       INTEGER(i4)                                        :: il_ighost 
    511       INTEGER(i4)                                        :: il_jghost 
    512       INTEGER(i4)      , DIMENSION(2)                    :: il_xghost 
     641      INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost 
    513642      INTEGER(i4)      , DIMENSION(3)                    :: il_dim 
    514643      INTEGER(i4)      , DIMENSION(3)                    :: il_size 
     
    522651 
    523652      TYPE(TVAR)                                         :: tl_lon 
    524       TYPE(TVAR)                                         :: tl_lat 
    525       TYPE(TVAR)                                         :: tl_var 
    526653      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim 
     654 
     655      TYPE(TMPP)                                         :: tl_coord 
    527656 
    528657      ! loop indices 
     
    532661      !---------------------------------------------------------------- 
    533662 
    534       !1- read output grid 
    535       tl_lon=iom_read_var(td_coord,'longitude') 
    536       tl_lat=iom_read_var(td_coord,'latitude') 
    537  
    538       !2- look for ghost cell 
    539       il_xghost(:)=grid_get_ghost( tl_lon, tl_lat ) 
    540  
    541       il_ighost=il_xghost(1)*ig_ghost 
    542       il_jghost=il_xghost(2)*ig_ghost 
    543        
    544       !3- write value on grid 
    545       !3-1 get matrix dimension 
     663      ! copy structure 
     664      tl_coord=mpp_copy(td_coord) 
     665 
     666      ! use only edge processor 
     667      CALL mpp_get_contour(tl_coord) 
     668 
     669      ! open useful processor 
     670      CALL iom_mpp_open(tl_coord) 
     671 
     672      ! read output grid 
     673      tl_lon=iom_mpp_read_var(tl_coord,'longitude') 
     674 
     675      ! look for ghost cell 
     676      il_xghost(:,:)=grid_get_ghost( tl_coord ) 
     677 
     678      ! close processor 
     679      CALL iom_mpp_close(tl_coord) 
     680      ! clean 
     681      CALL mpp_clean(tl_coord) 
     682 
     683      ! remove ghost cell 
     684      CALL grid_del_ghost(tl_lon, il_xghost(:,:)) 
     685 
     686      ! write value on grid 
     687      ! get matrix dimension 
    546688      il_dim(:)=td_var%t_dim(1:3)%i_len 
    547       !3-2 output dimension 
    548       tl_dim(:)=tl_lon%t_dim(:) 
    549  
    550       ! remove ghost cell 
    551       tl_dim(1)%i_len=tl_dim(1)%i_len - 2*il_xghost(1)*ig_ghost 
    552       tl_dim(2)%i_len=tl_dim(2)%i_len - 2*il_xghost(2)*ig_ghost 
    553  
    554       !3-3 split output domain in N subdomain depending of matrix dimension  
     689      ! output dimension 
     690      tl_dim(:)=dim_copy(tl_lon%t_dim(:)) 
     691      ! clean 
     692      CALL var_clean(tl_lon) 
     693 
     694      ! split output domain in N subdomain depending of matrix dimension  
    555695      il_size(:) = tl_dim(1:3)%i_len / il_dim(:) 
    556696      il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:)) 
     
    563703      ! add rest to last cell 
    564704      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1) 
    565        
    566705 
    567706      ALLOCATE( il_jshape(il_dim(2)+1) ) 
     
    581720      il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3) 
    582721 
    583       !3-3 write ouput table of value  
     722      ! write ouput array of value  
    584723      ALLOCATE(dl_value( tl_dim(1)%i_len, & 
    585724      &                  tl_dim(2)%i_len, & 
     
    602741      ENDDO 
    603742 
    604       !3-4 initialise variable with value 
    605       tl_var=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:)) 
     743      ! initialise variable with value 
     744      create_bathy_matrix=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:)) 
    606745 
    607746      DEALLOCATE(dl_value) 
    608747 
    609       !4- add ghost cell 
    610       CALL grid_add_ghost(tl_var,il_ighost,il_jghost) 
    611  
    612       !5- save result 
    613       create_bathy_matrix=tl_var 
     748      ! add ghost cell 
     749      CALL grid_add_ghost(create_bathy_matrix, il_xghost(:,:)) 
     750 
     751      ! clean 
     752      CALL dim_clean(tl_dim(:)) 
    614753 
    615754   END FUNCTION create_bathy_matrix 
    616    !> @endcode 
    617755   !------------------------------------------------------------------- 
    618756   !> @brief 
    619    !> This subroutine 
     757   !> This function extract variable from file over coordinate domain and 
     758   !> return variable structure 
    620759   !>  
    621    !> @details  
     760   !> @author J.Paul 
     761   !> - November, 2013- Initial Version 
    622762   !> 
    623    !> @author J.Paul 
    624    !> - Nov, 2013- Initial Version 
    625    !> 
    626    !> @param[in]  
     763   !> @param[in] td_var    variable structure  
     764   !> @param[in] td_mpp    mpp file structure 
     765   !> @param[in] td_coord  coordinate file structure 
     766   !> @return variable structure 
    627767   !------------------------------------------------------------------- 
    628    !> @code 
    629    FUNCTION create_bathy_extract(td_var, td_file, & 
     768   FUNCTION create_bathy_extract(td_var, td_mpp, & 
    630769   &                             td_coord) 
    631770      IMPLICIT NONE 
    632771      ! Argument 
    633       TYPE(TVAR) , INTENT(IN) :: td_var   
    634       TYPE(TFILE), INTENT(IN) :: td_file 
    635       TYPE(TFILE), INTENT(IN) :: td_coord 
     772      TYPE(TVAR), INTENT(IN) :: td_var   
     773      TYPE(TMPP), INTENT(IN) :: td_mpp 
     774      TYPE(TMPP), INTENT(IN) :: td_coord 
    636775 
    637776      ! function 
     
    639778 
    640779      ! local variable 
    641       INTEGER(i4), DIMENSION(2,2,2) :: il_ind 
    642  
    643       INTEGER(i4) :: il_pivot 
    644       INTEGER(i4) :: il_perio 
     780      INTEGER(i4), DIMENSION(2,2) :: il_ind 
    645781 
    646782      INTEGER(i4) :: il_imin 
     
    648784      INTEGER(i4) :: il_imax 
    649785      INTEGER(i4) :: il_jmax 
    650  
    651       TYPE(TFILE) :: tl_file 
    652786 
    653787      TYPE(TMPP)  :: tl_mpp 
     
    661795      !---------------------------------------------------------------- 
    662796 
    663       IF( td_file%i_id == 0 )THEN 
    664          CALL logger_error("CREATE BATHY EXTRACT: file "//& 
    665          &  TRIM(td_file%c_name)//" not opened ") 
     797      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 
     798         CALL logger_error("CREATE BATHY EXTRACT: no processor associated "//& 
     799         &  "to mpp "//TRIM(td_mpp%c_name)) 
    666800      ELSE 
    667801 
    668802         !init 
    669          tl_file=td_file 
    670  
    671          !1- open file 
    672          CALL iom_open(tl_file) 
    673  
    674          ! get periodicity 
    675          il_pivot=grid_get_pivot(tl_file) 
    676          il_perio=grid_get_perio(tl_file,il_pivot) 
    677  
    678          tl_file%i_perio=il_perio 
    679  
    680          !2- compute file grid indices around coord grid 
    681          il_ind(:,:,:)=grid_get_coarse_index(tl_file, td_coord ) 
    682  
    683          il_imin=il_ind(1,1,1) ; il_imax=il_ind(1,2,1) 
    684          il_jmin=il_ind(2,1,1) ; il_jmax=il_ind(2,2,1) 
    685  
    686          IF( ANY( il_ind(:,:,2) /= 0 ) )THEN 
    687             CALL logger_error("CREATE BATHY EXTRACT: something wrong "//& 
    688             &  " find offset when extracting data") 
    689          ENDIF 
    690          !3- check grid coincidence 
    691          CALL grid_check_coincidence( tl_file, td_coord, & 
     803         tl_mpp=mpp_copy(td_mpp) 
     804 
     805         ! compute file grid indices around coord grid 
     806         il_ind(:,:)=grid_get_coarse_index(tl_mpp, td_coord ) 
     807 
     808         il_imin=il_ind(1,1) ; il_imax=il_ind(1,2) 
     809         il_jmin=il_ind(2,1) ; il_jmax=il_ind(2,2) 
     810 
     811         ! check grid coincidence 
     812         CALL grid_check_coincidence( tl_mpp, td_coord, & 
    692813         &                            il_imin, il_imax, & 
    693814         &                            il_jmin, il_jmax, & 
    694815         &                            (/1, 1, 1/) ) 
    695816 
    696          !4- compute domain 
    697          tl_dom=dom_init(tl_file,         & 
     817         ! compute domain 
     818         tl_dom=dom_init(tl_mpp,           & 
    698819         &               il_imin, il_imax, & 
    699820         &               il_jmin, il_jmax) 
    700821 
    701          ! close file 
    702          CALL iom_close(tl_file) 
    703  
    704          !5- read bathymetry on domain (ugly way to do it, have to work on it) 
    705          !5-1 init mpp structure 
    706          tl_mpp=mpp_init(tl_file) 
    707  
    708          CALL file_clean(tl_file) 
    709  
    710          !5-2 get processor to be used 
    711          CALL mpp_get_use( tl_mpp, tl_dom ) 
    712  
    713          !5-3 open mpp files 
    714          CALL iom_mpp_open(tl_mpp) 
    715  
    716          !5-4 read variable on domain 
    717          tl_var=iom_mpp_read_var(tl_mpp,TRIM(td_var%c_name),td_dom=tl_dom) 
    718  
    719          !5-5 close mpp file 
    720          CALL iom_mpp_close(tl_mpp) 
    721  
    722          !6- add ghost cell 
    723          CALL grid_add_ghost(tl_var,tl_dom%i_ighost,tl_dom%i_jghost) 
    724  
    725          !7- check result 
     822         ! open mpp files over domain 
     823         CALL iom_dom_open(tl_mpp, tl_dom) 
     824 
     825         ! read variable on domain 
     826         tl_var=iom_dom_read_var(tl_mpp,TRIM(td_var%c_name),tl_dom) 
     827 
     828         ! close mpp file 
     829         CALL iom_dom_close(tl_mpp) 
     830 
     831         ! add ghost cell 
     832         CALL grid_add_ghost(tl_var,tl_dom%i_ghost(:,:)) 
     833 
     834         ! check result 
    726835         IF( ANY( tl_var%t_dim(:)%l_use .AND. & 
    727836         &        tl_var%t_dim(:)%i_len /= td_coord%t_dim(:)%i_len) )THEN 
     
    743852         ENDIF 
    744853 
    745          !8- add attribute to variable 
     854         ! add attribute to variable 
    746855         tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 
    747856         CALL var_move_att(tl_var, tl_att)          
    748857 
    749          tl_att=att_init('src_i-indices',(/tl_dom%i_imin, tl_dom%i_imax/)) 
     858         tl_att=att_init('src_i_indices',(/tl_dom%i_imin, tl_dom%i_imax/)) 
    750859         CALL var_move_att(tl_var, tl_att) 
    751860 
    752          tl_att=att_init('src_j-indices',(/tl_dom%i_jmin, tl_dom%i_jmax/)) 
     861         tl_att=att_init('src_j_indices',(/tl_dom%i_jmin, tl_dom%i_jmax/)) 
    753862         CALL var_move_att(tl_var, tl_att) 
    754863 
    755          !9- save result 
    756          create_bathy_extract=tl_var 
     864         ! save result 
     865         create_bathy_extract=var_copy(tl_var) 
    757866 
    758867         ! clean structure 
     868         CALL att_clean(tl_att) 
    759869         CALL var_clean(tl_var) 
    760870         CALL mpp_clean(tl_mpp) 
     
    762872 
    763873   END FUNCTION create_bathy_extract 
    764    !> @endcode 
    765874   !------------------------------------------------------------------- 
    766875   !> @brief 
    767    !> This subroutine 
     876   !> This function get coarse grid variable, interpolate variable, and return 
     877   !> variable structure over fine grid 
    768878   !>  
    769    !> @details  
     879   !> @author J.Paul 
     880   !> - November, 2013- Initial Version 
    770881   !> 
    771    !> @author J.Paul 
    772    !> - Nov, 2013- Initial Version 
    773    !> 
    774    !> @param[in] td_var : variable structure 
    775    !> @param[in] td_file : file structure 
    776    !> @param[in] id_imin : i-direction lower left  corner indice  
    777    !> @param[in] id_imax : i-direction upper right corner indice  
    778    !> @param[in] id_jmin : j-direction lower left  corner indice 
    779    !> @param[in] id_jmax : j-direction upper right corner indice  
    780    !> @param[in] id_rho  : table of refinement factor 
     882   !> @param[in] td_var    variable structure 
     883   !> @param[in] td_mpp    mpp file structure 
     884   !> @param[in] id_imin   i-direction lower left  corner indice  
     885   !> @param[in] id_imax   i-direction upper right corner indice  
     886   !> @param[in] id_jmin   j-direction lower left  corner indice 
     887   !> @param[in] id_jmax   j-direction upper right corner indice  
     888   !> @param[in] id_offset offset between fine grid and coarse grid 
     889   !> @param[in] id_rho    array of refinement factor 
     890   !> @return variable structure 
    781891   !------------------------------------------------------------------- 
    782    !> @code 
    783    FUNCTION create_bathy_get_var(td_var, td_file,  & 
     892   FUNCTION create_bathy_get_var(td_var, td_mpp,   & 
    784893            &                    id_imin, id_jmin, & 
    785894            &                    id_imax, id_jmax, & 
     
    789898      ! Argument 
    790899      TYPE(TVAR) , INTENT(IN) :: td_var   
    791       TYPE(TFILE), INTENT(IN) :: td_file  
     900      TYPE(TMPP) , INTENT(IN) :: td_mpp  
    792901      INTEGER(i4), INTENT(IN) :: id_imin 
    793902      INTEGER(i4), INTENT(IN) :: id_imax 
     
    801910 
    802911      ! local variable 
    803       INTEGER(i4) :: il_pivot 
    804       INTEGER(i4) :: il_perio 
    805  
    806       TYPE(TFILE) :: tl_file 
    807  
    808912      TYPE(TMPP)  :: tl_mpp 
    809  
    810913      TYPE(TATT)  :: tl_att 
    811  
    812914      TYPE(TVAR)  :: tl_var 
    813        
    814915      TYPE(TDOM)  :: tl_dom 
     916 
     917      INTEGER(i4) :: il_size 
     918      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    815919 
    816920      ! loop indices 
    817921      !---------------------------------------------------------------- 
    818922      IF( ANY(SHAPE(id_offset(:,:)) /= 2) )THEN 
    819          CALL logger_error("CREATE BATHY GET VAR: invalid dimensio of "//& 
    820          &                 "offset table") 
     923         CALL logger_error("CREATE BATHY GET VAR: invalid dimension of "//& 
     924         &                 "offset array") 
    821925      ENDIF 
    822926 
    823       !init 
    824       tl_file=td_file 
    825  
    826       !1- open file 
    827       CALL iom_open(tl_file) 
    828  
    829       ! get periodicity 
    830       il_pivot=grid_get_pivot(tl_file) 
    831       il_perio=grid_get_perio(tl_file,il_pivot) 
    832  
    833       tl_file%i_perio=il_perio 
    834  
    835       !2- compute domain 
    836       tl_dom=dom_init(tl_file,          & 
     927      ! copy structure 
     928      tl_mpp=mpp_copy(td_mpp) 
     929 
     930      !- compute domain 
     931      tl_dom=dom_init(tl_mpp,           & 
    837932      &               id_imin, id_imax, & 
    838933      &               id_jmin, id_jmax) 
    839934 
    840       CALL dom_print(tl_dom) 
    841       print *,'id_offset ',id_offset(:,:) 
    842       !3- close file 
    843       CALL iom_close(tl_file)       
    844  
    845       !4- add extra band (if possible) to compute interpolation 
     935      !- add extra band (if possible) to compute interpolation 
    846936      CALL dom_add_extra(tl_dom) 
    847937 
    848       !5- read bathymetry on domain (ugly way to do it, have to work on it) 
    849       !5-1 init mpp sturcutre 
    850       tl_mpp=mpp_init(tl_file) 
    851  
    852       CALL file_clean(tl_file) 
    853  
    854       !5-2 get processor to be used 
    855       CALL mpp_get_use( tl_mpp, tl_dom ) 
    856  
    857       !5-3 open mpp files 
    858       CALL iom_mpp_open(tl_mpp) 
    859  
    860       !5-4 read variable value on domain 
    861       tl_var=iom_mpp_read_var(tl_mpp,TRIM(td_var%c_name),td_dom=tl_dom) 
    862  
    863       !5-5 close mpp files 
    864       CALL iom_mpp_close(tl_mpp)       
    865  
    866       !6- interpolate variable 
    867       CALL create_bathy_interp(tl_var, id_rho(:), id_offset(:,:)) 
    868  
    869       !7- remove extraband added to domain 
    870       CALL dom_del_extra( tl_var, tl_dom, id_rho(:) ) 
    871  
    872       !8- add ghost cell 
    873       CALL grid_add_ghost(tl_var,tl_dom%i_ighost,tl_dom%i_jghost) 
     938      !- open mpp files over domain 
     939      CALL iom_dom_open(tl_mpp, tl_dom) 
     940 
     941      !- read variable value on domain 
     942      tl_var=iom_dom_read_var(tl_mpp,TRIM(td_var%c_name),tl_dom) 
     943 
     944      !- close mpp files 
     945      CALL iom_dom_close(tl_mpp) 
     946 
     947      il_size=SIZE(id_rho(:)) 
     948      ALLOCATE( il_rho(il_size) ) 
     949      il_rho(:)=id_rho(:) 
     950       
     951      !- interpolate variable 
     952      CALL create_bathy_interp(tl_var, il_rho(:), id_offset(:,:)) 
     953 
     954      !- remove extraband added to domain 
     955      CALL dom_del_extra( tl_var, tl_dom, il_rho(:) ) 
     956 
     957      !- add ghost cell 
     958      CALL grid_add_ghost(tl_var,tl_dom%i_ghost(:,:)) 
    874959  
    875       !9- add attribute to variable 
     960      !- add attribute to variable 
    876961      tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 
    877962      CALL var_move_att(tl_var, tl_att) 
    878963 
    879       tl_att=att_init('src_i-indices',(/tl_dom%i_imin, tl_dom%i_imax/)) 
     964      tl_att=att_init('src_i_indices',(/tl_dom%i_imin, tl_dom%i_imax/)) 
    880965      CALL var_move_att(tl_var, tl_att) 
    881966 
    882       tl_att=att_init('src_j-indices',(/tl_dom%i_jmin, tl_dom%i_jmax/)) 
     967      tl_att=att_init('src_j_indices',(/tl_dom%i_jmin, tl_dom%i_jmax/)) 
    883968      CALL var_move_att(tl_var, tl_att) 
    884969 
    885       !10- save result 
    886       create_bathy_get_var=tl_var 
    887  
    888       !11- clean structure 
     970      IF( .NOT. ALL(id_rho(:)==1) )THEN 
     971         tl_att=att_init("refinment_factor",(/id_rho(jp_I),id_rho(jp_J)/)) 
     972         CALL var_move_att(tl_var, tl_att) 
     973      ENDIF 
     974 
     975      DEALLOCATE( il_rho ) 
     976 
     977      !- save result 
     978      create_bathy_get_var=var_copy(tl_var) 
     979 
     980      !- clean structure 
     981      CALL att_clean(tl_att) 
     982      CALL var_clean(tl_var) 
    889983      CALL mpp_clean(tl_mpp) 
    890984  
    891985   END FUNCTION create_bathy_get_var 
    892    !> @endcode 
    893986   !------------------------------------------------------------------- 
    894987   !> @brief 
    895    !> This subroutine 
     988   !> This subroutine interpolate variable 
    896989   !>  
    897    !> @details  
     990   !> @author J.Paul 
     991   !> - November, 2013- Initial Version 
    898992   !> 
    899    !> @author J.Paul 
    900    !> - Nov, 2013- Initial Version 
    901    !> 
    902    !> @param[in]  
    903    !> @todo  
     993   !> @param[inout] td_var variable structure  
     994   !> @param[in] id_rho    array of refinment factor 
     995   !> @param[in] id_offset array of offset between fine and coarse grid 
     996   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext) 
     997   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext) 
    904998   !------------------------------------------------------------------- 
    905    !> @code 
    906999   SUBROUTINE create_bathy_interp( td_var,         & 
    9071000   &                               id_rho,          & 
     
    9191012 
    9201013      ! local variable 
    921       TYPE(TVAR)  :: tl_var 
    9221014      TYPE(TVAR)  :: tl_mask 
    9231015 
     
    9291021      ! loop indices 
    9301022      !---------------------------------------------------------------- 
    931  
    932       ! copy variable 
    933       tl_var=td_var 
    9341023 
    9351024      !WARNING: two extrabands are required for cubic interpolation 
     
    9521041      ENDIF 
    9531042 
    954       !1- work on mask 
    955       !1-1 create mask 
    956       ALLOCATE(bl_mask(tl_var%t_dim(1)%i_len, & 
    957       &                tl_var%t_dim(2)%i_len, & 
    958       &                tl_var%t_dim(3)%i_len, & 
    959       &                tl_var%t_dim(4)%i_len) ) 
     1043      ! work on mask 
     1044      ! create mask 
     1045      ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, & 
     1046      &                td_var%t_dim(2)%i_len, & 
     1047      &                td_var%t_dim(3)%i_len, & 
     1048      &                td_var%t_dim(4)%i_len) ) 
    9601049 
    9611050      bl_mask(:,:,:,:)=1 
    962       WHERE(tl_var%d_value(:,:,:,:)==tl_var%d_fill) bl_mask(:,:,:,:)=0       
    963  
    964       SELECT CASE(TRIM(tl_var%c_point)) 
     1051      WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0       
     1052 
     1053      SELECT CASE(TRIM(td_var%c_point)) 
    9651054      CASE DEFAULT ! 'T' 
    966          tl_mask=var_init('tmask', bl_mask(:,:,:,:), td_dim=tl_var%t_dim(:)) 
    967       CASE('U') 
    968          tl_mask=var_init('umask', bl_mask(:,:,:,:), td_dim=tl_var%t_dim(:)) 
    969       CASE('V') 
    970          tl_mask=var_init('vmask', bl_mask(:,:,:,:), td_dim=tl_var%t_dim(:)) 
    971       CASE('F') 
    972          tl_mask=var_init('fmask', bl_mask(:,:,:,:), td_dim=tl_var%t_dim(:)) 
     1055         tl_mask=var_init('tmask', bl_mask(:,:,:,:), td_dim=td_var%t_dim(:), & 
     1056         &                id_ew=td_var%i_ew ) 
     1057      CASE('U','V','F') 
     1058         CALL logger_fatal("CREATE BATHY INTERP: can not computed "//& 
     1059         &                 "interpolation on "//TRIM(td_var%c_point)//& 
     1060         &                 " grid point (variable "//TRIM(td_var%c_name)//& 
     1061         &                 "). check namelist.") 
    9731062      END SELECT 
    9741063 
    9751064      DEALLOCATE(bl_mask) 
    9761065 
    977       !1-2 interpolate mask 
     1066      ! interpolate mask 
    9781067      CALL interp_fill_value( tl_mask, id_rho(:), & 
    9791068      &                       id_offset=id_offset(:,:) ) 
    9801069 
    981       !2- work on variable 
    982       !2-0 add extraband 
    983       CALL extrap_add_extrabands(tl_var, il_iext, il_jext) 
    984  
    985       !2-1 extrapolate variable 
    986       CALL extrap_fill_value( tl_var, id_offset=id_offset(:,:), & 
     1070      ! work on variable 
     1071      ! add extraband 
     1072      CALL extrap_add_extrabands(td_var, il_iext, il_jext) 
     1073 
     1074      ! extrapolate variable 
     1075      CALL extrap_fill_value( td_var, id_offset=id_offset(:,:), & 
    9871076      &                               id_rho=id_rho(:),         & 
    9881077      &                               id_iext=il_iext, id_jext=il_jext ) 
    9891078 
    990       !2-2 interpolate Bathymetry 
    991       CALL interp_fill_value( tl_var, id_rho(:), & 
     1079      ! interpolate Bathymetry 
     1080      CALL interp_fill_value( td_var, id_rho(:), & 
    9921081      &                       id_offset=id_offset(:,:) ) 
    9931082 
    994       !2-3 remove extraband 
    995       CALL extrap_del_extrabands(tl_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 
    996  
    997       !2-2-5 keep original mask  
     1083      ! remove extraband 
     1084      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 
     1085 
     1086      ! keep original mask  
    9981087      WHERE( tl_mask%d_value(:,:,:,:) == 0 ) 
    999          tl_var%d_value(:,:,:,:)=tl_var%d_fill 
     1088         td_var%d_value(:,:,:,:)=td_var%d_fill 
    10001089      END WHERE 
    1001  
    1002       !3- save result 
    1003       td_var=tl_var 
    10041090 
    10051091      ! clean variable structure 
    10061092      CALL var_clean(tl_mask) 
    1007       CALL var_clean(tl_var) 
    10081093 
    10091094   END SUBROUTINE create_bathy_interp 
    1010    !> @endcode 
    10111095END PROGRAM create_bathy 
Note: See TracChangeset for help on using the changeset viewer.