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_boundary.f90

    r4213 r5600  
    77! 
    88! DESCRIPTION: 
     9!> @file 
    910!> @brief  
    1011!> This program create boundary files. 
    1112!> 
    1213!> @details 
    13 !> Variables are read from standard output. 
    14 !> Then theses variables are interpolated on fine grid boundaries. 
    15 !> 
    16 !> @author 
    17 !> J.Paul 
     14!> @section sec1 method 
     15!> Variables are read from coarse grid standard output  
     16!> and interpolated on fine grid or manually written.<br/> 
     17!> @note  
     18!>    method could be different for each variable. 
     19!> 
     20!> @section sec2 how to  
     21!>    to create boundaries files:<br/> 
     22!> @code{.sh} 
     23!>    ./SIREN/bin/create_boundary create_boundary.nam 
     24!> @endcode 
     25!>     
     26!>    create_boundary.nam comprise 9 namelists:<br/> 
     27!>       - logger namelist (namlog) 
     28!>       - config namelist (namcfg) 
     29!>       - coarse grid namelist (namcrs) 
     30!>       - fine grid namelist (namfin) 
     31!>       - variable namelist (namvar) 
     32!>       - nesting namelist (namnst) 
     33!>       - boundary namelist (nambdy) 
     34!>       - vertical grid namelist (namzgr) 
     35!>       - output namelist (namout) 
     36!>     
     37!>    @note  
     38!>       All namelists have to be in file create_boundary.nam,  
     39!>       however variables of those namelists are all optional. 
     40!> 
     41!>    * _logger namelist (namlog)_:<br/> 
     42!>       - cn_logfile   : log filename 
     43!>       - cn_verbosity : verbosity ('trace','debug','info', 
     44!> 'warning','error','fatal') 
     45!>       - in_maxerror  : maximum number of error allowed 
     46!> 
     47!>    * _config namelist (namcfg)_:<br/> 
     48!>       - cn_varcfg : variable configuration file 
     49!> (see ./SIREN/cfg/variable.cfg) 
     50!> 
     51!>    * _coarse grid namelist (namcrs)_:<br/> 
     52!>       - cn_coord0 : coordinate file 
     53!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in 
     54!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals)) 
     55!> 
     56!>    * _fine grid namelist (namfin)_:<br/> 
     57!>       - cn_coord1 : coordinate file 
     58!>       - cn_bathy1 : bathymetry file 
     59!>       - in_perio1 : periodicity index 
     60!> 
     61!>    * _vertical grid namelist (namzgr)_:<br/> 
     62!>       - dn_pp_to_be_computed  : 
     63!>       - dn_ppsur              : 
     64!>       - dn_ppa0               : 
     65!>       - dn_ppa1               : 
     66!>       - dn_ppa2               :  
     67!>       - dn_ppkth              : 
     68!>       - dn_ppkth2             : 
     69!>       - dn_ppacr              : 
     70!>       - dn_ppacr2             : 
     71!>       - dn_ppdzmin            : 
     72!>       - dn_pphmax             : 
     73!>       - in_nlevel             : number of vertical level 
     74!> 
     75!>    * _partial step namelist (namzps)_:<br/> 
     76!>       - dn_e3zps_mi           : 
     77!>       - dn_e3zps_rat          :  
     78!> 
     79!>    * _variable namelist (namvar)_:<br/> 
     80!>       - cn_varinfo : list of variable and extra information about request(s) 
     81!> to be used.<br/> 
     82!>          each elements of *cn_varinfo* is a string character.<br/> 
     83!>          it is composed of the variable name follow by ':',  
     84!>          then request(s) to be used on this variable.<br/>  
     85!>          request could be: 
     86!>             - interpolation method 
     87!>             - extrapolation method 
     88!>             - filter method 
     89!> 
     90!>                requests must be separated by ';'.<br/> 
     91!>                order of requests does not matter. 
     92!> 
     93!>          informations about available method could be find in @ref interp, 
     94!>          @ref extrap and @ref filter.<br/> 
     95!> 
     96!>          Example: 'votemper:linear;hann;dist_weight', 'vosaline:cubic' 
     97!>          @note  
     98!>             If you do not specify a method which is required,  
     99!>             default one is apply. 
     100!>       - cn_varfile : list of variable, and corresponding file<br/>  
     101!>          *cn_varfile* is the path and filename of the file where find 
     102!>          variable.<br/>  
     103!>          @note  
     104!>             *cn_varfile* could be a matrix of value, if you want to filled 
     105!>             manually variable value.<br/> 
     106!>             the variable array of value is split into equal subdomain.<br/> 
     107!>             Each subdomain is filled with the corresponding value  
     108!>             of the matrix.<br/>           
     109!>             separators used to defined matrix are: 
     110!>                - ',' for line 
     111!>                - '/' for row 
     112!>                - '\' for level<br/> 
     113!>                Example:<br/> 
     114!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc} 
     115!>                                         3 & 2 & 3 \\ 
     116!>                                         1 & 4 & 5 \end{array} \right) @f$ 
     117!>          @warning  
     118!>             the same matrix is used for all boundaries. 
     119!> 
     120!>       Examples:  
     121!>          - 'votemper:gridT.nc', 'vozocrtx:gridU.nc' 
     122!>          - 'votemper:10\25', 'vozocrtx:gridU.nc' 
     123!> 
     124!>    * _nesting namelist (namnst)_:<br/> 
     125!>       - in_rhoi  : refinement factor in i-direction 
     126!>       - in_rhoj  : refinement factor in j-direction 
     127!> 
     128!>    * _boundary namelist (nambdy)_:<br/> 
     129!>       - ln_north  : use north boundary 
     130!>       - ln_south  : use south boundary 
     131!>       - ln_east   : use east  boundary 
     132!>       - ln_west   : use west  boundary 
     133!>       - cn_north  : north boundary indices on fine grid 
     134!>          *cn_north* is a string character defining boundary 
     135!>          segmentation.<br/> 
     136!>          segments are separated by '|'.<br/> 
     137!>          each segments of the boundary is composed of: 
     138!>             - orthogonal indice (.ie. for north boundary, 
     139!>             J-indice where boundary are).  
     140!>             - first indice of boundary (I-indice for north boundary)  
     141!>             - last  indice of boundary (I-indice for north boundary)<br/> 
     142!>                indices must be separated by ',' .<br/> 
     143!>             - optionally, boundary size could be added between '(' and ')'  
     144!>             in the first segment defined. 
     145!>                @note  
     146!>                   boundary width is the same for all segments of one boundary. 
     147!> 
     148!>          Examples: 
     149!>             - cn_north='index1,first1,last1(width)' 
     150!>             - cn_north='index1(width),first1,last1|index2,first2,last2' 
     151!> 
     152!>          \image html  boundary_50.png  
     153!>          \image latex boundary_50.png 
     154!> 
     155!>       - cn_south  : south boundary indices on fine grid 
     156!>       - cn_east   : east  boundary indices on fine grid 
     157!>       - cn_west   : west  boundary indices on fine grid 
     158!>       - ln_oneseg : use only one segment for each boundary or not 
     159!>       - in_extrap : number of mask point to be extrapolated 
     160!> 
     161!>   * _output namelist (namout)_:<br/> 
     162!>       - cn_fileout : fine grid boundary basename 
     163!>         (cardinal and segment number will be automatically added) 
     164!> 
     165!> @author J.Paul 
    18166! REVISION HISTORY: 
    19 !> @date Nov, 2013 - Initial Version 
    20 ! 
     167!> @date November, 2013 - Initial Version 
     168!> @date September, 2014 
     169!> - add header for user 
     170!> - take into account grid point to compue boundaries 
     171!> - reorder output dimension for north and south boundaries  
     172!> 
    21173!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    22 !> 
    23 !> @todo 
    24174!---------------------------------------------------------------------- 
    25 !> @code 
    26175PROGRAM create_boundary 
    27176 
     
    57206   CHARACTER(LEN=lc)                                  :: cl_bdyout 
    58207   CHARACTER(LEN=lc)                                  :: cl_data 
     208   CHARACTER(LEN=lc)                                  :: cl_dimorder 
     209   CHARACTER(LEN=lc)                                  :: cl_point 
     210   CHARACTER(LEN=lc)                                  :: cl_fmt 
    59211 
    60212   INTEGER(i4)                                        :: il_narg 
    61213   INTEGER(i4)                                        :: il_status 
    62214   INTEGER(i4)                                        :: il_fileid 
    63    INTEGER(i4)                                        :: il_attid 
    64215   INTEGER(i4)                                        :: il_dim 
    65216   INTEGER(i4)                                        :: il_imin0 
     
    67218   INTEGER(i4)                                        :: il_jmin0 
    68219   INTEGER(i4)                                        :: il_jmax0 
     220   INTEGER(i4)                                        :: il_shift 
    69221   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho 
    70222   INTEGER(i4)      , DIMENSION(2,2)                  :: il_offset 
    71    INTEGER(i4)      , DIMENSION(2,2,2)                :: il_ind 
     223   INTEGER(i4)      , DIMENSION(2,2                :: il_ind 
    72224 
    73225   LOGICAL                                            :: ll_exist 
    74  
    75    TYPE(TFILE)                                        :: tl_coord0 
    76    TYPE(TFILE)                                        :: tl_bathy0 
    77    TYPE(TFILE)                                        :: tl_coord1 
    78    TYPE(TFILE)                                        :: tl_bathy1 
    79    TYPE(TFILE)                                        :: tl_file 
    80    TYPE(TFILE)                                        :: tl_fileout 
    81     
    82    TYPE(TMPP)                                         :: tl_mpp 
    83  
    84    TYPE(TMULTI)                                       :: tl_multi 
    85226 
    86227   TYPE(TATT)                                         :: tl_att 
    87228    
     229   TYPE(TVAR)                                         :: tl_depth    
     230   TYPE(TVAR)                                         :: tl_time 
     231   TYPE(TVAR)                                         :: tl_var1 
     232   TYPE(TVAR)                                         :: tl_var0 
     233   TYPE(TVAR)                                         :: tl_lon1 
     234   TYPE(TVAR)                                         :: tl_lat1 
     235   TYPE(TVAR)                                         :: tl_lvl1   
    88236   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_level 
    89237   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_seglvl1 
    90    TYPE(TVAR)                                         :: tl_var1 
    91238   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segvar1 
    92    TYPE(TVAR)       , DIMENSION(:,:)    , ALLOCATABLE :: tl_seglon1 
    93    TYPE(TVAR)       , DIMENSION(:,:)    , ALLOCATABLE :: tl_seglat1 
    94    TYPE(TVAR)       , DIMENSION(:,:)    , ALLOCATABLE :: tl_var 
    95    TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_lon1 
    96    TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_lat1 
    97    TYPE(TVAR)                                         :: tl_depth    
    98    TYPE(TVAR)                                         :: tl_time 
    99    TYPE(TVAR)                                         :: tl_tmp    
    100239 
    101240   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim 
     
    104243    
    105244   TYPE(TDOM)                                         :: tl_dom0 
    106    TYPE(TDOM)       , DIMENSION(:,:)    , ALLOCATABLE :: tl_segdom1 
     245   TYPE(TDOM)                                         :: tl_dom1 
     246   TYPE(TDOM)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segdom1 
     247 
     248   TYPE(TFILE)                                        :: tl_fileout 
     249    
     250   TYPE(TMPP)                                         :: tl_coord0 
     251   TYPE(TMPP)                                         :: tl_coord1 
     252   TYPE(TMPP)                                         :: tl_bathy1 
     253   TYPE(TMPP)                                         :: tl_mpp 
     254 
     255   TYPE(TMULTI)                                       :: tl_multi 
    107256 
    108257   ! loop indices 
    109258   INTEGER(i4) :: jvar 
     259   INTEGER(i4) :: jpoint 
    110260   INTEGER(i4) :: ji 
    111261   INTEGER(i4) :: jj 
     
    117267   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_boundary.log'  
    118268   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning'  
     269   INTEGER(i4)                             :: in_maxerror = 5 
     270 
     271   ! namcfg 
     272   CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg'  
    119273 
    120274   ! namcrs 
     
    127281   INTEGER(i4)                             :: in_perio1 = -1 
    128282 
    129    ! namcfg 
    130    CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg'  
     283   !namzgr 
     284   INTEGER(i4)                             :: in_nlevel = 75 
    131285 
    132286   ! namvar 
    133    CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varinfo = '' 
    134    CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varfile = '' 
     287   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
     288   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
    135289 
    136290   ! namnst 
    137    INTEGER(i4)                             :: in_imin0 = 0 
    138    INTEGER(i4)                             :: in_imax0 = 0 
    139    INTEGER(i4)                             :: in_jmin0 = 0 
    140    INTEGER(i4)                             :: in_jmax0 = 0 
    141    INTEGER(i4)                             :: in_rhoi  = 1 
    142    INTEGER(i4)                             :: in_rhoj  = 1 
     291   INTEGER(i4)                             :: in_rhoi  = 0 
     292   INTEGER(i4)                             :: in_rhoj  = 0 
    143293 
    144294   ! nambdy 
     
    160310   NAMELIST /namlog/ &  !< logger namelist 
    161311   &  cn_logfile,    &  !< log file 
    162    &  cn_verbosity      !< log verbosity 
     312   &  cn_verbosity,  &  !< log verbosity 
     313   &  in_maxerror 
    163314 
    164315   NAMELIST /namcfg/ &  !< config namelist 
     
    174325   &  in_perio1         !< periodicity index 
    175326  
     327   NAMELIST /namzgr/ & 
     328   &  in_nlevel 
     329 
    176330   NAMELIST /namvar/ &  !< variable namelist 
    177331   &  cn_varinfo,    &  !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' ) 
     
    179333    
    180334   NAMELIST /namnst/ &  !< nesting namelist 
    181    &  in_imin0,      &  !< i-direction lower left  point indice on coarse grid  
    182    &  in_imax0,      &  !< i-direction upper right point indice on coarse grid 
    183    &  in_jmin0,      &  !< j-direction lower left  point indice on coarse grid 
    184    &  in_jmax0,      &  !< j-direction upper right point indice on coarse grid 
    185335   &  in_rhoi,       &  !< refinement factor in i-direction 
    186336   &  in_rhoj           !< refinement factor in j-direction 
     
    196346   &  cn_west ,      &  !< west  boundary indices on fine grid 
    197347   &  ln_oneseg,     &  !< use only one segment for each boundary or not 
    198    &  in_extrap         !< number of mask point to extrapolate 
     348   &  in_extrap         !< number of mask point to be extrapolated 
    199349 
    200350   NAMELIST /namout/ &  !< output namelist 
     
    202352   !------------------------------------------------------------------- 
    203353 
    204    !1- namelist 
    205    !1-1 get namelist 
     354   ! namelist 
     355   ! get namelist 
    206356   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec 
    207357   IF( il_narg/=1 )THEN 
     
    212362   ENDIF 
    213363    
    214    !1-2 read namelist 
     364   ! read namelist 
    215365   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 
    216366   IF( ll_exist )THEN 
     
    231381 
    232382      READ( il_fileid, NML = namlog ) 
    233       !1-2-1 define log file 
    234       CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity)) 
     383      ! define log file 
     384      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror) 
    235385      CALL logger_header() 
    236386 
    237387      READ( il_fileid, NML = namcfg ) 
    238       !1-2-2 get variable extra information 
     388      ! get variable extra information 
    239389      CALL var_def_extra(TRIM(cn_varcfg)) 
    240390 
    241391      READ( il_fileid, NML = namcrs ) 
    242392      READ( il_fileid, NML = namfin ) 
     393      READ( il_fileid, NML = namzgr ) 
    243394      READ( il_fileid, NML = namvar ) 
    244       !1-2-3 add user change in extra information 
     395      ! add user change in extra information 
    245396      CALL var_chg_extra(cn_varinfo) 
    246       !1-2-4 match variable with file 
     397      ! match variable with file 
    247398      tl_multi=multi_init(cn_varfile) 
    248399 
    249400      READ( il_fileid, NML = namnst ) 
    250401      READ( il_fileid, NML = nambdy ) 
    251  
    252402      READ( il_fileid, NML = namout ) 
    253403 
     
    261411 
    262412      PRINT *,"CREATE BOUNDARY: ERROR. can not find "//TRIM(cl_namelist) 
     413      STOP 
    263414 
    264415   ENDIF 
    265416 
    266    !2- open files 
     417   CALL multi_print(tl_multi) 
     418   IF( tl_multi%i_nvar <= 0 )THEN 
     419      CALL logger_fatal("CREATE BOUNDARY: no variable to be used."//& 
     420      &  " check namelist.") 
     421   ENDIF 
     422 
     423   ! open files 
    267424   IF( TRIM(cn_coord0) /= '' )THEN 
    268       tl_coord0=file_init(TRIM(cn_coord0),id_perio=in_perio0) 
    269       CALL iom_open(tl_coord0) 
     425      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0) 
     426      CALL grid_get_info(tl_coord0) 
    270427   ELSE 
    271428      CALL logger_fatal("CREATE BOUNDARY: can not find coarse grid "//& 
     
    274431 
    275432   IF( TRIM(cn_coord1) /= '' )THEN 
    276       tl_coord1=file_init(TRIM(cn_coord1),id_perio=in_perio1) 
    277       CALL iom_open(tl_coord1) 
     433      tl_coord1=mpp_init( file_init(TRIM(cn_coord1)), id_perio=in_perio1) 
     434      CALL grid_get_info(tl_coord1) 
    278435   ELSE 
    279436      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid coordinate "//& 
     
    282439 
    283440   IF( TRIM(cn_bathy1) /= '' )THEN 
    284       tl_bathy1=file_init(TRIM(cn_bathy1),id_perio=in_perio1) 
    285       CALL iom_open(tl_bathy1) 
     441      tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1) 
     442      CALL grid_get_info(tl_bathy1) 
    286443   ELSE 
    287444      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid bathymetry "//& 
     
    289446   ENDIF 
    290447 
    291    !3- check 
    292    !3-1 check output file do not already exist 
     448   ! check 
     449   ! check output file do not already exist 
    293450   DO jk=1,ip_ncard 
    294451      cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
    295       &                                TRIM(ip_card(jk)) ) 
     452      &                                TRIM(cp_card(jk)), 1 ) 
    296453      INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist) 
    297454      IF( ll_exist )THEN 
     
    301458   ENDDO 
    302459 
    303    !3-1 check namelist 
    304    !3-1-1 check refinement factor 
     460   ! check namelist 
     461   ! check refinement factor 
    305462   il_rho(:)=1 
    306463   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN 
     
    312469   ENDIF 
    313470 
    314    !3-1-2 
    315    IF( in_imin0 < 1 .OR. in_imax0 < 1 .OR. in_jmin0 < 1 .OR. in_jmax0 < 1)THEN 
    316       ! compute coarse grid indices around fine grid 
    317       il_ind(:,:,:)=grid_get_coarse_index(tl_bathy0, tl_bathy1 ) 
    318  
    319       il_imin0=il_ind(1,1,1) ; il_imax0=il_ind(1,2,1) 
    320       il_jmin0=il_ind(2,1,1) ; il_jmax0=il_ind(2,2,1) 
    321    ELSE 
    322       il_imin0=in_imin0 ; il_imax0=in_imax0 
    323       il_jmin0=in_jmin0 ; il_jmax0=in_jmax0 
    324    ENDIF 
    325  
    326    !3-2 check domain validity 
     471   ! 
     472   ! compute coarse grid indices around fine grid 
     473   il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, & 
     474   &                                 id_rho=il_rho(:)) 
     475 
     476   il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2) 
     477   il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2) 
     478 
     479   ! check domain validity 
    327480   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0) 
    328481 
    329    !3-3 check coordinate file 
     482   ! check coordinate file 
    330483   CALL grid_check_coincidence( tl_coord0, tl_coord1, & 
    331484   &                            il_imin0, il_imax0, & 
     
    333486   &                            il_rho(:) )       
    334487 
    335    !4- read or compute boundary 
    336    tl_var1=iom_read_var(tl_bathy1,'Bathymetry') 
     488   ! read or compute boundary 
     489   CALL mpp_get_contour(tl_bathy1) 
     490 
     491   CALL iom_mpp_open(tl_bathy1) 
     492    
     493   tl_var1=iom_mpp_read_var(tl_bathy1,'Bathymetry') 
     494    
     495   CALL iom_mpp_close(tl_bathy1) 
    337496 
    338497   tl_bdy(:)=boundary_init(tl_var1, ln_north, ln_south, ln_east, ln_west, & 
     
    342501   CALL var_clean(tl_var1) 
    343502 
    344    !5- compute level 
    345    ALLOCATE(tl_level(ig_npoint)) 
     503   ! compute level 
     504   ALLOCATE(tl_level(ip_npoint)) 
    346505   tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 
    347506 
    348    !6- get coordinate on each segment of each boundary 
    349    ALLOCATE( tl_seglon1(ip_ncard,ig_maxseg) ) 
    350    ALLOCATE( tl_seglat1(ip_ncard,ig_maxseg) ) 
    351    ALLOCATE( tl_segdom1(ip_ncard,ig_maxseg) ) 
    352    ALLOCATE( tl_segvar1(tl_multi%i_nvar,ip_ncard,ig_maxseg) ) 
    353    ALLOCATE( tl_seglvl1(ip_ncard,ig_maxseg,ig_npoint) ) 
    354    DO jk=1,ip_ncard 
    355       IF( tl_bdy(jk)%l_use )THEN 
    356          DO jl=1,tl_bdy(jk)%i_nseg 
    357             !6-1 get fine grid segment domain 
    358             tl_segdom1(jk,jl)=create_boundary_get_dom( tl_bathy1, tl_bdy(jk), jl ) 
    359  
    360             !6-2 get fine grid segment coordinate 
    361             CALL create_boundary_get_coord( tl_bathy1, tl_segdom1(jk,jl), & 
    362             &                               tl_seglon1(jk,jl), tl_seglat1(jk,jl) ) 
    363             !6-2 get fine grid segment coordinate 
    364             tl_seglvl1(jk,jl,:)=create_bdy_get_level(tl_level(:), tl_segdom1(jk,jl)) 
     507   ! get coordinate on each segment of each boundary 
     508   ALLOCATE( tl_segdom1(ip_npoint,ip_maxseg,ip_ncard) ) 
     509   ALLOCATE( tl_seglvl1(ip_npoint,ip_maxseg,ip_ncard) ) 
     510    
     511   DO jl=1,ip_ncard 
     512      IF( tl_bdy(jl)%l_use )THEN 
     513         DO jk=1,tl_bdy(jl)%i_nseg 
     514 
     515            ! get fine grid segment domain 
     516            tl_segdom1(:,jk,jl)=create_boundary_get_dom( tl_bathy1, & 
     517            &                                            tl_bdy(jl), jk ) 
     518 
     519            ! add extra band to fine grid domain (if possible) 
     520            ! to avoid dimension of one and so be able to compute offset 
     521            DO jj=1,ip_npoint 
     522               CALL dom_add_extra(tl_segdom1(jj,jk,jl), & 
     523               &                  il_rho(jp_I), il_rho(jp_J)) 
     524            ENDDO 
     525 
     526            ! get fine grid level 
     527            tl_seglvl1(:,jk,jl)=create_boundary_get_level( tl_level(:), & 
     528                                                           tl_segdom1(:,jk,jl)) 
    365529 
    366530         ENDDO 
     
    368532   ENDDO 
    369533 
     534   ! clean 
     535   CALL var_clean(tl_level(:)) 
    370536   DEALLOCATE(tl_level) 
    371537 
    372    !7- compute boundary for variable to be used (see namelist) 
    373    IF( .NOT. ASSOCIATED(tl_multi%t_file) )THEN 
     538   ! clean bathy 
     539   CALL mpp_clean(tl_bathy1) 
     540 
     541   ALLOCATE( tl_segvar1(tl_multi%i_nvar,ip_maxseg,ip_ncard) ) 
     542   ! compute boundary for variable to be used (see namelist) 
     543   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN 
    374544      CALL logger_error("CREATE BOUNDARY: no file to work on. "//& 
    375545      &                 "check cn_varfile in namelist.") 
    376546   ELSE 
     547 
    377548      jvar=0 
    378549      ! for each file 
    379       DO ji=1,tl_multi%i_nfile 
    380          WRITE(cl_data,'(a,i2.2)') 'data_',jvar+1 
    381  
    382          IF( .NOT. ASSOCIATED(tl_multi%t_file(ji)%t_var) )THEN 
     550      DO ji=1,tl_multi%i_nmpp 
     551 
     552         WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1 
     553 
     554         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN 
     555 
    383556            CALL logger_error("CREATE BOUNDARY: no variable to work on for "//& 
    384             &                 "file "//TRIM(tl_multi%t_file(ji)%c_name)//& 
     557            &                 "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//& 
    385558            &                 ". check cn_varfile in namelist.") 
     559 
     560         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN 
     561         !- use input matrix to fill variable 
     562 
     563            WRITE(*,'(a)') "work on data" 
     564            ! for each variable initialise from matrix 
     565            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     566 
     567               jvar=jvar+1 
     568               WRITE(*,'(2x,a,a)') "work on variable "//& 
     569               &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
     570 
     571               tl_var1=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 
     572 
     573               SELECT CASE(TRIM(tl_var1%c_point)) 
     574               CASE DEFAULT !'T' 
     575                  jpoint=jp_T 
     576               CASE('U') 
     577                  jpoint=jp_U 
     578               CASE('V') 
     579                  jpoint=jp_V 
     580               CASE('F') 
     581                  jpoint=jp_F 
     582               END SELECT 
     583 
     584               WRITE(*,'(4x,a,a)') 'work on '//TRIM(tl_var1%c_name) 
     585               DO jl=1,ip_ncard 
     586                  IF( tl_bdy(jl)%l_use )THEN 
     587 
     588                     DO jk=1,tl_bdy(jl)%i_nseg 
     589 
     590                        ! fill value with matrix data 
     591                        tl_segvar1(jvar,jk,jl)=create_boundary_matrix( & 
     592                        &                          tl_var1, & 
     593                        &                          tl_segdom1(jpoint,jk,jl), & 
     594                        &                          in_nlevel ) 
     595 
     596                        ! use mask 
     597                        CALL create_boundary_use_mask( tl_segvar1(jvar,jk,jl), & 
     598                        &                         tl_seglvl1(jpoint,jk,jl)) 
     599 
     600                        !del extra 
     601                        CALL dom_del_extra( tl_segvar1(jvar,jk,jl), & 
     602                        &                   tl_segdom1(jpoint,jk,jl) ) 
     603 
     604                     ENDDO 
     605 
     606                  ENDIF 
     607               ENDDO 
     608                
     609               ! clean 
     610               CALL var_clean(tl_var1) 
     611 
     612            ENDDO 
     613 
     614         !- end of use input matrix to fill variable 
    386615         ELSE 
    387             IF( .NOT. ASSOCIATED(tl_multi%t_file(ji)%t_var) )THEN 
    388  
    389                CALL logger_error("CREATE BOUNDARY: no variable to work on for "//& 
    390                &                 "file "//TRIM(tl_multi%t_file(ji)%c_name)//& 
    391                &                 ". check cn_varfile in namelist.") 
    392  
    393             ELSEIF( TRIM(tl_multi%t_file(ji)%c_name) == TRIM(cl_data) )THEN 
    394             !- use input matrix to fill variable 
    395  
    396                ! for each variable initialise from matrix 
    397                DO jj=1,tl_multi%t_file(ji)%i_nvar 
    398                   jvar=jvar+1 
    399                   tl_tmp=tl_multi%t_file(ji)%t_var(jj) 
    400                   DO jk=1,ip_ncard 
    401                      IF( tl_bdy(jk)%l_use )THEN 
    402                         DO jl=1,tl_bdy(jk)%i_nseg 
    403                            !7-1 fill value with matrix data 
    404                            ! pb voir comment gerer nb de dimension 
    405                            tl_segvar1(jvar,jk,jl)=create_bdy_matrix(tl_tmp, tl_segdom1(jk,jl), tl_coord1) 
    406  
    407                            !7-2 use mask 
    408                            CALL create_bdy_use_mask(tl_segvar1(jvar,jk,jl), tl_seglvl1(jk,jl,:)) 
    409                         ENDDO 
    410                      ENDIF 
    411                   ENDDO 
    412                ENDDO 
    413  
     616         !- use file to fill variable 
     617 
     618            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name) 
     619            !  
     620            tl_mpp=mpp_init(file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name))) 
     621            CALL grid_get_info(tl_mpp) 
     622 
     623            ! check vertical dimension 
     624            IF( tl_mpp%t_dim(jp_K)%l_use .AND. & 
     625            &   tl_mpp%t_dim(jp_K)%i_len /= in_nlevel  )THEN 
     626               CALL logger_error("CREATE BOUNDARY: dimension in file "//& 
     627               &  TRIM(tl_mpp%c_name)//" not agree with namelist in_nlevel ") 
     628            ENDIF 
     629 
     630            ! open mpp file 
     631            CALL iom_mpp_open(tl_mpp) 
     632 
     633            ! get or check depth value 
     634            CALL create_boundary_check_depth( tl_mpp, tl_depth ) 
     635 
     636            ! get or check time value 
     637            CALL create_boundary_check_time( tl_mpp, tl_time ) 
     638 
     639            ! close mpp file 
     640            CALL iom_mpp_close(tl_mpp) 
     641 
     642            IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 
     643            &        tl_coord0%t_dim(1:2)%i_len) )THEN 
     644            !- extract value from fine grid 
     645 
     646               IF( ANY( tl_mpp%t_dim(1:2)%i_len <= & 
     647               &        tl_coord1%t_dim(1:2)%i_len) )THEN 
     648                  CALL logger_fatal("CREATE BOUNDARY: dimension in file "//& 
     649                  &  TRIM(tl_mpp%c_name)//" smaller than those in fine"//& 
     650                  &  " grid coordinates.") 
     651               ENDIF 
     652 
     653               DO jl=1,ip_ncard 
     654                  IF( tl_bdy(jl)%l_use )THEN 
     655                      
     656                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary' 
     657                     DO jk=1,tl_bdy(jl)%i_nseg 
     658                        ! compute domain on fine grid 
     659                         
     660                        ! for each variable of this file 
     661                        DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     662                            
     663                           cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name 
     664                           WRITE(*,'(4x,a,a)') "work on variable "//TRIM(cl_name) 
     665 
     666                           cl_point=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_point 
     667                           ! open mpp file on domain 
     668                           SELECT CASE(TRIM(cl_point)) 
     669                              CASE DEFAULT !'T' 
     670                                 jpoint=jp_T 
     671                              CASE('U') 
     672                                 jpoint=jp_U 
     673                              CASE('V') 
     674                                 jpoint=jp_V 
     675                              CASE('F') 
     676                                 jpoint=jp_F 
     677                           END SELECT 
     678 
     679                           tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 
     680                           tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl)) 
     681 
     682                           ! open mpp files 
     683                           CALL iom_dom_open(tl_mpp, tl_dom1) 
     684 
     685                           !7-5 read variable over domain 
     686                           tl_segvar1(jvar+jj,jk,jl)=iom_dom_read_var( & 
     687                           &                     tl_mpp, TRIM(cl_name), tl_dom1) 
     688 
     689                           ! use mask 
     690                           CALL create_boundary_use_mask( & 
     691                           &                 tl_segvar1(jvar+jj,jk,jl), tl_lvl1) 
     692 
     693                           ! del extra point 
     694                           CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
     695                           &                   tl_dom1 ) 
     696 
     697                           ! clean extra point information on fine grid domain 
     698                           CALL dom_clean_extra( tl_dom1 ) 
     699 
     700                           ! add attribute to variable 
     701                           tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 
     702                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
     703 
     704                           tl_att=att_init('src_i_indices',(/tl_dom1%i_imin, tl_dom1%i_imax/)) 
     705                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
     706 
     707                           tl_att=att_init('src_j_indices',(/tl_dom1%i_jmin, tl_dom1%i_jmax/)) 
     708                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
     709 
     710                           ! clean structure 
     711                           CALL att_clean(tl_att) 
     712                           CALL dom_clean(tl_dom1) 
     713 
     714                           ! close mpp files 
     715                           CALL iom_dom_close(tl_mpp) 
     716 
     717                           ! clean 
     718                           CALL var_clean(tl_lvl1) 
     719 
     720                        ENDDO ! jj 
     721                     ENDDO ! jk 
     722 
     723                  ENDIF 
     724               ENDDO ! jl 
     725 
     726               ! clean 
     727               CALL mpp_clean(tl_mpp) 
     728 
     729               jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     730 
     731            !- end of extract value from fine grid 
    414732            ELSE 
    415             !- use file to fill variable 
    416  
    417                ! open file 
    418                tl_file=file_init(TRIM(tl_multi%t_file(ji)%c_name)) 
    419                CALL iom_open(tl_file) 
    420  
    421                ! get or check depth value 
    422                IF( tl_file%i_depthid /= 0 )THEN 
    423                   IF( ASSOCIATED(tl_depth%d_value) )THEN 
    424                      IF( ANY( tl_depth%d_value(:,:,:,:) /= & 
    425                      &        tl_tmp%d_value(:,:,:,:) ) )THEN 
    426                         CALL logger_fatal("CREATE BOUNDARY: depth value from "//& 
    427                         &  TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& 
    428                         &  " to those from former file(s).") 
    429                      ENDIF 
    430                   ELSE 
    431                      tl_depth=iom_read_var(tl_file,tl_file%i_depthid) 
    432                   ENDIF 
    433                ENDIF 
    434  
    435                ! get or check time value 
    436                IF( tl_file%i_timeid /= 0 )THEN 
    437                   IF( ASSOCIATED(tl_time%d_value) )THEN 
    438                      IF( ANY( tl_time%d_value(:,:,:,:) /= & 
    439                      &        tl_tmp%d_value(:,:,:,:) ) )THEN 
    440                         CALL logger_fatal("CREATE BOUNDARY: time value from "//& 
    441                         &  TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& 
    442                         &  " to those from former file(s).") 
    443                      ENDIF 
    444                   ELSE 
    445                      tl_time=iom_read_var(tl_file,tl_file%i_timeid) 
    446                   ENDIF 
    447                ENDIF 
    448  
    449                IF( ANY( tl_file%t_dim(1:2)%i_len /= & 
    450                &      tl_coord0%t_dim(1:2)%i_len) )THEN 
    451                !- extract value from fine grid 
    452                   DO jk=1,ip_ncard 
    453                      IF( tl_bdy(jk)%l_use )THEN 
    454  
    455                         DO jl=1,tl_bdy(jk)%i_nseg 
    456                            !7-1 compute domain on fine grid 
     733            !- interpolate value from coarse grid 
     734 
     735               DO jl=1,ip_ncard 
     736                  IF( tl_bdy(jl)%l_use )THEN 
     737 
     738                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary' 
     739                     DO jk=1,tl_bdy(jl)%i_nseg 
     740                         
     741                        ! for each variable of this file 
     742                        DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    457743                            
     744                           WRITE(*,'(4x,a,a)') "work on variable "//& 
     745                           &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
     746 
     747                           tl_var0=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 
    458748                           ! open mpp file on domain 
    459                            !7-2 init mpp structure 
    460                            tl_mpp=mpp_init(tl_file) 
    461  
    462                            !7-3 get processor to be used 
    463                            CALL mpp_get_use( tl_mpp, tl_segdom1(jk,jl) ) 
    464                            !7-4 open mpp files 
    465                            CALL iom_mpp_open(tl_mpp) 
    466  
    467                            ! for each variable of this file 
    468                            DO jj=1,tl_multi%t_file(ji)%i_nvar 
    469                                
    470                               cl_name=tl_multi%t_file(ji)%t_var(jj)%c_name 
    471                               !7-5 read variable over domain 
    472                               tl_segvar1(jvar+jj,jk,jl)=iom_mpp_read_var( tl_mpp, TRIM(cl_name), & 
    473                               &                                           td_dom=tl_segdom1(jk,jl) ) 
    474  
    475                               !7-6 add attribute to variable 
    476                               tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 
    477                               CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    478  
    479                               tl_att=att_init('src_i-indices',(/tl_segdom1(jk,jl)%i_imin, tl_segdom1(jk,jl)%i_imax/)) 
    480                               CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    481  
    482                               tl_att=att_init('src_j-indices',(/tl_segdom1(jk,jl)%i_jmin, tl_segdom1(jk,jl)%i_jmax/)) 
    483                               CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    484                                
    485                               ! clean structure 
    486                               CALL att_clean(tl_att) 
    487  
    488                               !7-7 use mask 
    489                               CALL create_bdy_use_mask(tl_segvar1(jvar+jj,jk,jl), tl_seglvl1(jk,jl,:)) 
    490                            ENDDO 
    491                             
    492                            !7-8 close mpp files 
    493                            CALL iom_mpp_close(tl_mpp) 
    494  
    495                            CALL mpp_clean(tl_mpp) 
    496  
    497                         ENDDO 
    498                      ENDIF 
    499                   ENDDO 
    500                   jvar=jvar+tl_multi%t_file(ji)%i_nvar 
    501                ELSE 
    502                !- interpolate value from coarse grid 
    503  
    504                   DO jk=1,ip_ncard 
    505                      IF( tl_bdy(jk)%l_use )THEN 
    506  
    507                         DO jl=1,tl_bdy(jk)%i_nseg 
    508                            !7-1 get coarse grid indices of this segment 
    509                            il_ind(:,:,:)=grid_get_coarse_index(tl_coord0, & 
    510                            &                                   tl_seglon1(jk,jl), tl_seglat1(jk,jl), & 
    511                            &                                   id_rho=il_rho(:) ) 
    512  
    513                            IF( ANY(il_ind(:,:,:)==0) )THEN 
    514                               CALL logger_error("CREATE BOUNDARY: error computing "//& 
    515                               &                 " coarse grid indices") 
     749                           SELECT CASE(TRIM(tl_var0%c_point)) 
     750                              CASE DEFAULT !'T' 
     751                                 jpoint=jp_T 
     752                              CASE('U') 
     753                                 jpoint=jp_U 
     754                              CASE('V') 
     755                                 jpoint=jp_V 
     756                              CASE('F') 
     757                                 jpoint=jp_F 
     758                           END SELECT 
     759 
     760                           tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 
     761                           tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl)) 
     762 
     763                           CALL create_boundary_get_coord( tl_coord1, tl_dom1, & 
     764                           &                               tl_var0%c_point,    & 
     765                           &                               tl_lon1, tl_lat1 ) 
     766 
     767                           ! get coarse grid indices of this segment 
     768                           il_ind(:,:)=grid_get_coarse_index(tl_coord0, & 
     769                           &                                 tl_lon1, tl_lat1, & 
     770                           &                                 id_rho=il_rho(:) ) 
     771 
     772                           IF( ANY(il_ind(:,:)==0) )THEN 
     773                              CALL logger_error("CREATE BOUNDARY: error "//& 
     774                              &  "computing coarse grid indices") 
    516775                           ELSE 
    517                               il_imin0=il_ind(1,1,1) 
    518                               il_imax0=il_ind(1,2,1) 
    519  
    520                               il_jmin0=il_ind(2,1,1) 
    521                               il_jmax0=il_ind(2,2,1) 
    522  
    523                               il_offset(:,:)=il_ind(:,:,2) 
     776                              il_imin0=il_ind(1,1) 
     777                              il_imax0=il_ind(1,2) 
     778 
     779                              il_jmin0=il_ind(2,1) 
     780                              il_jmax0=il_ind(2,2) 
    524781                           ENDIF 
    525782 
    526                            !7-2 compute coarse grid segment domain 
     783                           il_offset(:,:)= grid_get_fine_offset( & 
     784                           &                    tl_coord0, & 
     785                           &                    il_imin0, il_jmin0,& 
     786                           &                    il_imax0, il_jmax0,& 
     787                           &                    tl_lon1%d_value(:,:,1,1),& 
     788                           &                    tl_lat1%d_value(:,:,1,1),& 
     789                           &                    il_rho(:),& 
     790                           &                    TRIM(tl_var0%c_point) ) 
     791 
     792                           ! compute coarse grid segment domain 
    527793                           tl_dom0=dom_init( tl_coord0,         & 
    528794                           &                 il_imin0, il_imax0,& 
    529795                           &                 il_jmin0, il_jmax0 ) 
    530796 
    531                            !7-3 add extra band (if possible) to compute interpolation 
     797                           ! add extra band (if possible) to compute interpolation 
    532798                           CALL dom_add_extra(tl_dom0) 
    533799 
    534                            !7-4 read variables on domain (ugly way to do it, have to work on it) 
    535                            !7-4-1 init mpp structure 
    536                            tl_mpp=mpp_init(tl_file) 
    537   
    538                            !7-4-2 get processor to be used 
    539                            CALL mpp_get_use( tl_mpp, tl_dom0 ) 
    540  
    541                            !7-4-3 open mpp files 
    542                            CALL iom_mpp_open(tl_mpp) 
    543  
    544                            ! check file dimension 
    545                            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) )THEN 
    546                               CALL logger_error("CREATE BOUNDARY INTERP: dimension of file "//& 
    547                               &  TRIM(tl_mpp%c_name)//" not conform to those of "//& 
    548                               &  TRIM(tl_coord0%c_name)) 
    549                            ELSE 
    550  
    551                               ! for each variable of this file 
    552                               DO jj=1,tl_multi%t_file(ji)%i_nvar 
    553  
    554                                  cl_name=tl_multi%t_file(ji)%t_var(jj)%c_name 
    555                                  !7-4-4 read variable value on domain 
    556                                  tl_segvar1(jvar+jj,jk,jl)=iom_mpp_read_var( tl_mpp, TRIM(cl_name), & 
    557                                  &                                           td_dom=tl_dom0 ) 
    558  
    559                                  !7-4-5 work on variable 
    560                                  CALL create_boundary_interp(tl_segvar1(jvar+jj,jk,jl), & 
    561                                  &                           il_rho(:), & 
    562                                  &                           il_offset(:,:) ) 
    563  
    564                                  !7-4-6 remove extraband added to domain 
    565                                  CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), tl_dom0, il_rho(:) ) 
    566  
    567                                  !7-4-7 keep only useful point (width)  
    568                                  ! interpolation could create more point than necessary 
    569                                  CALL boundary_clean_interp(tl_segvar1(jvar+jj,jk,jl), tl_bdy(jk) ) 
    570  
    571                                  !7-4-8 add attribute to variable 
    572                                  tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 
    573                                  CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    574  
    575                                  tl_att=att_init('src_i-indices',(/tl_dom0%i_imin, tl_dom0%i_imax/)) 
    576                                  CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    577  
    578                                  tl_att=att_init('src_j-indices',(/tl_dom0%i_jmin, tl_dom0%i_jmax/)) 
    579                                  CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    580  
    581                                  ! clean structure 
    582                                  CALL att_clean(tl_att) 
    583  
    584                                  !7-4-9 use mask 
    585                                  CALL create_bdy_use_mask(tl_segvar1(jvar+jj,jk,jl), tl_seglvl1(jk,jl,:)) 
    586                               ENDDO 
     800                           ! read variables on domain  
     801                           ! open mpp files 
     802                           CALL iom_dom_open(tl_mpp, tl_dom0) 
     803 
     804                           cl_name=tl_var0%c_name 
     805                           ! read variable value on domain 
     806                           tl_segvar1(jvar+jj,jk,jl)= & 
     807                           &    iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0) 
     808 
     809                           ! work on variable 
     810                           CALL create_boundary_interp( & 
     811                           &                 tl_segvar1(jvar+jj,jk,jl),& 
     812                           &                 il_rho(:), il_offset(:,:) ) 
     813 
     814                           ! remove extraband added to domain 
     815                           CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
     816                           &                   tl_dom0, il_rho(:) ) 
     817 
     818                           ! use mask 
     819                           CALL create_boundary_use_mask( & 
     820                           &     tl_segvar1(jvar+jj,jk,jl), tl_lvl1) 
     821 
     822                           ! del extra point on fine grid 
     823                           CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
     824                           &                   tl_dom1 ) 
     825                           ! clean extra point information on coarse grid domain 
     826                           CALL dom_clean_extra( tl_dom0 ) 
     827 
     828                           ! add attribute to variable 
     829                           tl_att=att_init('src_file',& 
     830                           &  TRIM(fct_basename(tl_mpp%c_name))) 
     831                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 
     832                           &                 tl_att) 
     833 
     834                           ! use clean extra avt creer attribut 
     835                           tl_att=att_init('src_i-indices',& 
     836                           &  (/tl_dom0%i_imin, tl_dom0%i_imax/)) 
     837                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 
     838                           &                 tl_att) 
     839 
     840                           tl_att=att_init('src_j-indices', & 
     841                           &  (/tl_dom0%i_jmin, tl_dom0%i_jmax/)) 
     842                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 
     843                           &                 tl_att) 
     844 
     845                           IF( ANY(il_rho(:)/=1) )THEN 
     846                              tl_att=att_init("refinment_factor", & 
     847                              &               (/il_rho(jp_I),il_rho(jp_J)/)) 
     848                              CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 
     849                              &                 tl_att) 
    587850                           ENDIF 
    588851 
     852                           ! clean structure 
     853                           CALL att_clean(tl_att) 
     854 
     855                           ! clean 
    589856                           CALL dom_clean(tl_dom0) 
    590  
    591                            !7-5 close mpp files 
    592                            CALL iom_mpp_close(tl_mpp) 
    593  
    594                            !7-6 clean structure 
    595                            CALL mpp_clean(tl_mpp) 
    596                         ENDDO 
    597                      ENDIF 
    598                   ENDDO 
    599                   jvar=jvar+tl_multi%t_file(ji)%i_nvar 
    600  
    601                ENDIF 
    602                CALL file_clean(tl_file) 
    603  
     857                           CALL dom_clean(tl_dom1) 
     858 
     859                           ! close mpp files 
     860                           CALL iom_dom_close(tl_mpp) 
     861 
     862                           ! clean structure 
     863                           CALL var_clean(tl_lon1) 
     864                           CALL var_clean(tl_lat1) 
     865                           CALL var_clean(tl_lvl1) 
     866 
     867                        ENDDO ! jj 
     868 
     869                        ! clean 
     870                        CALL var_clean(tl_var0) 
     871 
     872                     ENDDO ! jk 
     873                
     874                  ENDIF 
     875               ENDDO ! jl 
     876 
     877               jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     878 
     879            !- end of interpolate value from coarse grid 
    604880            ENDIF 
     881 
     882            ! clean 
     883            CALL mpp_clean(tl_mpp) 
     884 
     885         !- end of use file to fill variable 
    605886         ENDIF 
    606887      ENDDO 
    607888   ENDIF 
     889 
    608890   IF( jvar /= tl_multi%i_nvar )THEN 
    609891      CALL logger_error("CREATE BOUNDARY: it seems some variable can not be read") 
    610892   ENDIF 
    611893 
    612    !8- concatenate file 
    613    ALLOCATE( tl_lon1(ip_ncard) ) 
    614    ALLOCATE( tl_lat1(ip_ncard) ) 
    615    ALLOCATE( tl_var(tl_multi%i_nvar,ip_ncard) ) 
    616  
    617    DO jk=1,ip_ncard 
    618       IF( tl_bdy(jk)%l_use )THEN 
     894   CALL var_clean(tl_seglvl1(:,:,:)) 
     895   DEALLOCATE( tl_seglvl1 ) 
     896 
     897   ! write file for each segment of each boundary 
     898   DO jl=1,ip_ncard 
     899      IF( tl_bdy(jl)%l_use )THEN 
    619900 
    620901         SELECT CASE(TRIM(tl_bdy(jk)%c_card)) 
     
    625906         END SELECT    
    626907 
    627          DO jl=1,tl_bdy(jk)%i_nseg 
    628             !- concatenate variable 
    629             IF( jl == 1 )THEN 
    630                tl_lon1(jk)=tl_seglon1(jk,jl) 
    631                tl_lat1(jk)=tl_seglat1(jk,jl) 
    632                DO jvar=1,tl_multi%i_nvar 
    633                   tl_var(jvar,jk)=tl_segvar1(jvar,jk,jl) 
    634                ENDDO 
     908         DO jk=1,tl_bdy(jl)%i_nseg 
     909            !-  
     910            CALL create_boundary_get_coord( tl_coord1, tl_segdom1(jp_T,jk,jl),& 
     911            &                               'T', tl_lon1, tl_lat1 ) 
     912 
     913            ! del extra point on fine grid 
     914            CALL dom_del_extra( tl_lon1, tl_segdom1(jp_T,jk,jl) ) 
     915            CALL dom_del_extra( tl_lat1, tl_segdom1(jp_T,jk,jl) ) 
     916 
     917            ! clean 
     918            DO jpoint=1,ip_npoint 
     919               CALL dom_clean(tl_segdom1(jpoint,jk,jl)) 
     920            ENDDO 
     921 
     922            ! swap array 
     923            CALL boundary_swap(tl_lon1, tl_bdy(jl)) 
     924            CALL boundary_swap(tl_lat1, tl_bdy(jl)) 
     925            DO jvar=1,tl_multi%i_nvar 
     926               CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl)) 
     927 
     928               ! use additional request 
     929               ! forced min and max value 
     930               CALL var_limit_value(tl_segvar1(jvar,jk,jl)) 
     931 
     932               ! filter 
     933               CALL filter_fill_value(tl_segvar1(jvar,jk,jl)) 
     934 
     935               ! extrapolate 
     936               CALL extrap_fill_value( tl_segvar1(jvar,jk,jl), & 
     937               &                       id_iext=in_extrap,      & 
     938               &                       id_jext=in_extrap,      & 
     939               &                       id_kext=in_extrap ) 
     940 
     941            ENDDO 
     942 
     943            ! create file 
     944            ! create file structure 
     945            ! set file namearray of level variable structure 
     946            IF( ASSOCIATED(tl_time%d_value) )THEN 
     947               cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)" 
     948               cl_date=date_print( var_to_date(tl_time), cl_fmt )  
     949 
     950               cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
     951               &                                TRIM(tl_bdy(jl)%c_card), jk, TRIM(cl_date) ) 
    635952            ELSE 
    636                tl_lon1(jk)=var_concat(tl_lon1(jk),tl_seglon1(jk,jl),DIM=il_dim) 
    637                tl_lat1(jk)=var_concat(tl_lat1(jk),tl_seglat1(jk,jl),DIM=il_dim) 
    638                DO jvar=1,tl_multi%i_nvar 
    639                   tl_var(jvar,jk)=var_concat(tl_var(jvar,jk),tl_segvar1(jvar,jk,jl),DIM=il_dim) 
    640                ENDDO 
    641             ENDIF    
    642          ENDDO 
    643  
    644          ! swap array 
    645          CALL boundary_swap(tl_lon1(jk), tl_bdy(jk)) 
    646          CALL boundary_swap(tl_lat1(jk), tl_bdy(jk)) 
    647          DO jvar=1,tl_multi%i_nvar 
    648             CALL boundary_swap(tl_var(jvar,jk), tl_bdy(jk)) 
    649  
    650             !9- use additional request 
    651  
    652             !9-1 forced min and max value 
    653             CALL var_limit_value(tl_var(jvar,jk)) 
    654  
    655             !9-2 filter 
    656             CALL filter_fill_value(tl_var(jvar,jk)) 
    657  
    658             !9-3 extrapolate 
    659             CALL extrap_fill_value(tl_var(jvar,jk), id_iext=in_extrap, & 
    660             &                                       id_jext=in_extrap, & 
    661             &                                       id_kext=in_extrap) 
    662  
    663          ENDDO 
     953               cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
     954               &                                TRIM(tl_bdy(jl)%c_card), jk ) 
     955            ENDIF 
     956            !  
     957            tl_fileout=file_init(TRIM(cl_bdyout),id_perio=in_perio1) 
     958 
     959            ! add dimension 
     960            tl_dim(:)=var_max_dim(tl_segvar1(:,jk,jl)) 
     961 
     962            CALL dim_unorder(tl_dim(:)) 
     963            SELECT CASE(TRIM(tl_bdy(jl)%c_card)) 
     964               CASE DEFAULT ! 'north','south' 
     965                  cl_dimorder='xyzt' 
     966                  CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 
     967               CASE('east','west') 
     968                  cl_dimorder='yxzt' 
     969                  CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 
     970                  ! reorder coordinates dimension 
     971                  CALL var_reorder(tl_lon1,TRIM(cl_dimorder)) 
     972                  CALL var_reorder(tl_lat1,TRIM(cl_dimorder)) 
     973                  ! reorder other variable dimension 
     974                  DO jvar=1,tl_multi%i_nvar 
     975                     CALL var_reorder(tl_segvar1(jvar,jk,jl),TRIM(cl_dimorder)) 
     976                  ENDDO 
     977            END SELECT 
     978 
     979            DO ji=1,ip_maxdim 
     980               IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji)) 
     981            ENDDO 
     982 
     983            ! add variables 
     984            IF( ALL( tl_dim(1:2)%l_use ) )THEN 
     985               ! add longitude 
     986               CALL file_add_var(tl_fileout, tl_lon1) 
     987               CALL var_clean(tl_lon1) 
     988 
     989               ! add latitude 
     990               CALL file_add_var(tl_fileout, tl_lat1) 
     991               CALL var_clean(tl_lat1) 
     992            ENDIF 
     993             
     994            IF( tl_dim(3)%l_use )THEN 
     995               ! add depth 
     996               CALL file_add_var(tl_fileout, tl_depth) 
     997            ENDIF 
     998 
     999            IF( tl_dim(4)%l_use )THEN 
     1000               ! add time 
     1001               CALL file_add_var(tl_fileout, tl_time) 
     1002            ENDIF 
     1003 
     1004            ! add other variable 
     1005            DO jvar=1,tl_multi%i_nvar 
     1006               CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl)) 
     1007               CALL var_clean(tl_segvar1(jvar,jk,jl)) 
     1008            ENDDO 
     1009 
     1010            ! add some attribute 
     1011            tl_att=att_init("Created_by","SIREN create_boundary") 
     1012            CALL file_add_att(tl_fileout, tl_att) 
     1013 
     1014            cl_date=date_print(date_now()) 
     1015            tl_att=att_init("Creation_date",cl_date) 
     1016            CALL file_add_att(tl_fileout, tl_att) 
     1017 
     1018            ! add shift on north and east boundary 
     1019            ! boundary compute on T point but express on U or V point 
     1020            SELECT CASE(TRIM(tl_bdy(jl)%c_card)) 
     1021            CASE DEFAULT ! 'south','west' 
     1022               il_shift=0 
     1023            CASE('north','east') 
     1024               il_shift=1 
     1025            END SELECT 
     1026 
     1027            ! add indice of velocity row or column 
     1028            tl_att=att_init('bdy_ind',tl_bdy(jl)%t_seg(jk)%i_index-il_shift) 
     1029            CALL file_move_att(tl_fileout, tl_att) 
     1030 
     1031            ! add width of the relaxation zone 
     1032            tl_att=att_init('bdy_width',tl_bdy(jl)%t_seg(jk)%i_width) 
     1033            CALL file_move_att(tl_fileout, tl_att) 
     1034             
     1035            ! add indice of segment start  
     1036            tl_att=att_init('bdy_deb',tl_bdy(jl)%t_seg(jk)%i_first) 
     1037            CALL file_move_att(tl_fileout, tl_att) 
     1038             
     1039            ! add indice of segment end  
     1040            tl_att=att_init('bdy_end',tl_bdy(jl)%t_seg(jk)%i_last) 
     1041            CALL file_move_att(tl_fileout, tl_att) 
     1042                            
     1043            ! clean 
     1044            CALL att_clean(tl_att) 
     1045 
     1046            ! create file 
     1047            CALL iom_create(tl_fileout) 
     1048 
     1049            ! write file 
     1050            CALL iom_write_file(tl_fileout) 
     1051 
     1052            ! close file 
     1053            CALL iom_close(tl_fileout) 
     1054            CALL file_clean(tl_fileout) 
     1055 
     1056         ENDDO ! jk 
     1057 
    6641058      ENDIF 
    665    ENDDO 
    666  
    667    DEALLOCATE( tl_seglon1 ) 
    668    DEALLOCATE( tl_seglat1 ) 
     1059      ! clean 
     1060      CALL boundary_clean(tl_bdy(jl)) 
     1061   ENDDO !jl 
     1062 
     1063   ! clean 
     1064   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth) 
     1065   IF( ASSOCIATED(tl_time%d_value) )   CALL var_clean(tl_time) 
    6691066   DEALLOCATE( tl_segdom1 ) 
    6701067   DEALLOCATE( tl_segvar1 ) 
    671    DEALLOCATE( tl_seglvl1 ) 
    672     
    673    DO jk=1,ip_ncard 
    674       IF( tl_bdy(jk)%l_use )THEN 
    675  
    676          !10   create file 
    677          !10-1 create file structure 
    678          !10-1-1 set file name 
    679          cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
    680          &                                TRIM(tl_bdy(jk)%c_card) ) 
    681          !10-1-2  
    682          tl_fileout=file_init(TRIM(cl_bdyout),id_perio=in_perio1) 
    683  
    684          !10-2 add dimension 
    685          tl_dim(:)=var_max_dim(tl_var(:,jk)) 
    686  
    687          DO ji=1,ip_maxdim 
    688             IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji)) 
    689          ENDDO 
    690  
    691          !10-3 add variables 
    692          IF( ALL( tl_dim(1:2)%l_use ) )THEN 
    693             ! add longitude 
    694             CALL file_add_var(tl_fileout, tl_lon1(jk)) 
    695             CALL var_clean(tl_lon1(jk)) 
    696  
    697             ! add latitude 
    698             CALL file_add_var(tl_fileout, tl_lat1(jk)) 
    699             CALL var_clean(tl_lat1(jk)) 
    700          ENDIF 
    701           
    702          IF( tl_dim(3)%l_use )THEN 
    703             ! add depth 
    704             CALL file_add_var(tl_fileout, tl_depth) 
    705          ENDIF 
    706  
    707          IF( tl_dim(4)%l_use )THEN 
    708             ! add time 
    709             CALL file_add_var(tl_fileout, tl_time) 
    710          ENDIF 
    711  
    712          ! add other variable 
    713          DO jvar=1,tl_multi%i_nvar 
    714             !IF( TRIM(tl_var(jvar,jk)%c_name) /= 'X' .AND. & 
    715             !&   TRIM(tl_var(jvar,jk)%c_name) /= 'Y' )THEN 
    716                CALL file_add_var(tl_fileout, tl_var(jvar,jk)) 
    717             !ENDIF 
    718             CALL var_clean(tl_var(jvar,jk)) 
    719          ENDDO 
    720  
    721          !10-4 add some attribute 
    722          tl_att=att_init("Created_by","SIREN create_boundary") 
    723          CALL file_add_att(tl_fileout, tl_att) 
    724  
    725          cl_date=date_print(date_now()) 
    726          tl_att=att_init("Creation_date",cl_date) 
    727          CALL file_add_att(tl_fileout, tl_att) 
    728  
    729          ! add attribute periodicity 
    730          il_attid=0 
    731          IF( ASSOCIATED(tl_fileout%t_att) )THEN 
    732             il_attid=att_get_id(tl_fileout%t_att(:),'periodicity') 
    733          ENDIF 
    734          IF( tl_coord1%i_perio >= 0 .AND. il_attid == 0 )THEN 
    735             tl_att=att_init('periodicity',tl_coord1%i_perio) 
    736             CALL file_add_att(tl_fileout,tl_att) 
    737          ENDIF 
    738        
    739          il_attid=0 
    740          IF( ASSOCIATED(tl_fileout%t_att) )THEN 
    741             il_attid=att_get_id(tl_fileout%t_att(:),'ew_overlap') 
    742          ENDIF 
    743          IF( tl_coord1%i_ew >= 0 .AND. il_attid == 0 )THEN 
    744             tl_att=att_init('ew_overlap',tl_coord1%i_ew) 
    745             CALL file_add_att(tl_fileout,tl_att) 
    746          ENDIF 
    747  
    748          !10-5 create file 
    749          CALL iom_create(tl_fileout) 
    750  
    751          !10-6 write file 
    752          CALL iom_write_file(tl_fileout) 
    753  
    754          !10-7 close file 
    755          CALL iom_close(tl_fileout) 
    756          CALL file_clean(tl_fileout) 
    757  
    758       ENDIF 
    759    ENDDO 
    760    DEALLOCATE( tl_lon1 )  
    761    DEALLOCATE( tl_lat1 )  
    762    DEALLOCATE( tl_var )  
    763  
    764    !11- close file 
    765    CALL iom_close(tl_bathy1) 
    766    CALL iom_close(tl_coord1) 
    767    CALL iom_close(tl_coord0) 
    768  
    769    !12- clean 
    770    CALL var_clean(tl_depth) 
    771    CALL var_clean(tl_time) 
    772    CALL file_clean(tl_fileout) 
    773    CALL file_clean(tl_bathy1) 
    774    CALL file_clean(tl_coord1) 
    775    CALL file_clean(tl_coord0) 
     1068 
     1069   CALL mpp_clean(tl_coord1) 
     1070   CALL mpp_clean(tl_coord0) 
     1071 
     1072   CALL multi_clean(tl_multi) 
    7761073 
    7771074   ! close log file 
     
    7791076   CALL logger_close() 
    7801077 
    781 !> @endcode 
    7821078CONTAINS 
    7831079   !------------------------------------------------------------------- 
    7841080   !> @brief 
    785    !> This subroutine 
     1081   !> This subroutine compute boundary domain for each grid point (T,U,V,F)  
    7861082   !>  
    787    !> @details  
     1083   !> @author J.Paul 
     1084   !> - November, 2013- Initial Version 
     1085   !> @date September, 2014 
     1086   !> - take into account grid point to compute boundary indices 
    7881087   !> 
    789    !> @author J.Paul 
    790    !> - 2013- Initial Version 
    791    !> 
    792    !> @param[in]  
    793    !> @todo  
    794    !------------------------------------------------------------------- 
    795    !> @code 
     1088   !> @param[in] td_bathy1 file structure  
     1089   !> @param[in] td_bdy    boundary structure 
     1090   !> @param[in] id_seg    segment indice  
     1091   !> @return array of domain structure  
     1092   !------------------------------------------------------------------- 
    7961093   FUNCTION create_boundary_get_dom( td_bathy1, td_bdy, id_seg ) 
    7971094 
     
    7991096 
    8001097      ! Argument 
    801       TYPE(TFILE), INTENT(IN   ) :: td_bathy1 
     1098      TYPE(TMPP) , INTENT(IN   ) :: td_bathy1 
    8021099      TYPE(TBDY) , INTENT(IN   ) :: td_bdy 
    8031100      INTEGER(i4), INTENT(IN   ) :: id_seg 
    8041101 
    8051102      ! function 
    806       TYPE(TDOM) :: create_boundary_get_dom 
     1103      TYPE(TDOM), DIMENSION(ip_npoint) :: create_boundary_get_dom 
    8071104 
    8081105      ! local variable 
     
    8121109      INTEGER(i4) :: il_jmax1 
    8131110 
    814       TYPE(TFILE) :: tl_bathy1 
    815        
     1111      INTEGER(i4) :: il_imin 
     1112      INTEGER(i4) :: il_imax 
     1113      INTEGER(i4) :: il_jmin 
     1114      INTEGER(i4) :: il_jmax 
     1115 
     1116      INTEGER(i4), DIMENSION(ip_npoint) :: il_ishift 
     1117      INTEGER(i4), DIMENSION(ip_npoint) :: il_jshift 
     1118 
    8161119      ! loop indices 
    817       INTEGER(i4) :: jl 
     1120      INTEGER(i4) :: ji 
     1121      INTEGER(i4) :: jk 
    8181122      !---------------------------------------------------------------- 
    819       jl=id_seg 
    820  
    821       !1- get boundary definition 
     1123      ! init 
     1124      jk=id_seg 
     1125 
     1126      il_ishift(:)=0 
     1127      il_jshift(:)=0 
     1128 
     1129      ! get boundary definition 
    8221130      SELECT CASE(TRIM(td_bdy%c_card)) 
    8231131         CASE('north') 
    8241132 
    825             il_imin1=td_bdy%t_seg(jl)%i_first 
    826             il_imax1=td_bdy%t_seg(jl)%i_last  
    827             il_jmin1=td_bdy%t_seg(jl)%i_index-(td_bdy%t_seg(jl)%i_width-1) 
    828             il_jmax1=td_bdy%t_seg(jl)%i_index 
     1133            il_imin1=td_bdy%t_seg(jk)%i_first 
     1134            il_imax1=td_bdy%t_seg(jk)%i_last  
     1135            il_jmin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1) 
     1136            il_jmax1=td_bdy%t_seg(jk)%i_index 
     1137 
     1138            il_jshift(jp_V)=-1 
     1139            il_jshift(jp_F)=-1 
    8291140 
    8301141         CASE('south') 
    8311142 
    832             il_imin1=td_bdy%t_seg(jl)%i_first 
    833             il_imax1=td_bdy%t_seg(jl)%i_last  
    834             il_jmin1=td_bdy%t_seg(jl)%i_index 
    835             il_jmax1=td_bdy%t_seg(jl)%i_index+(td_bdy%t_seg(jl)%i_width-1) 
     1143            il_imin1=td_bdy%t_seg(jk)%i_first 
     1144            il_imax1=td_bdy%t_seg(jk)%i_last  
     1145            il_jmin1=td_bdy%t_seg(jk)%i_index 
     1146            il_jmax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1) 
    8361147 
    8371148         CASE('east') 
    8381149 
    839             il_imin1=td_bdy%t_seg(jl)%i_index-(td_bdy%t_seg(jl)%i_width-1) 
    840             il_imax1=td_bdy%t_seg(jl)%i_index 
    841             il_jmin1=td_bdy%t_seg(jl)%i_first 
    842             il_jmax1=td_bdy%t_seg(jl)%i_last  
     1150            il_imin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1) 
     1151            il_imax1=td_bdy%t_seg(jk)%i_index 
     1152            il_jmin1=td_bdy%t_seg(jk)%i_first 
     1153            il_jmax1=td_bdy%t_seg(jk)%i_last  
     1154 
     1155            il_ishift(jp_U)=-1 
     1156            il_ishift(jp_F)=-1 
    8431157 
    8441158         CASE('west') 
    8451159 
    846             il_imin1=td_bdy%t_seg(jl)%i_index 
    847             il_imax1=td_bdy%t_seg(jl)%i_index+(td_bdy%t_seg(jl)%i_width-1) 
    848             il_jmin1=td_bdy%t_seg(jl)%i_first 
    849             il_jmax1=td_bdy%t_seg(jl)%i_last  
     1160            il_imin1=td_bdy%t_seg(jk)%i_index 
     1161            il_imax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1) 
     1162            il_jmin1=td_bdy%t_seg(jk)%i_first 
     1163            il_jmax1=td_bdy%t_seg(jk)%i_last  
    8501164 
    8511165      END SELECT          
    8521166 
    853       !2 -read fine grid domain 
    854       tl_bathy1=td_bathy1 
    855       CALL iom_open(tl_bathy1) 
    856  
    857       !2-1 compute domain 
    858       create_boundary_get_dom=dom_init( tl_bathy1,         & 
    859       &                                 il_imin1, il_imax1,& 
    860       &                                 il_jmin1, il_jmax1 ) 
    861  
    862       !2-2 close file 
    863       CALL iom_close(tl_bathy1) 
     1167      !-read fine grid domain 
     1168      DO ji=1,ip_npoint 
     1169 
     1170         ! shift domain 
     1171         il_imin=il_imin1+il_ishift(ji) 
     1172         il_imax=il_imax1+il_ishift(ji) 
     1173 
     1174         il_jmin=il_jmin1+il_jshift(ji) 
     1175         il_jmax=il_jmax1+il_jshift(ji) 
     1176 
     1177         ! compute domain 
     1178         create_boundary_get_dom(ji)=dom_init( td_bathy1,       & 
     1179         &                                     il_imin, il_imax,& 
     1180         &                                     il_jmin, il_jmax,& 
     1181         &                                     TRIM(td_bdy%c_card) ) 
     1182 
     1183      ENDDO 
    8641184 
    8651185   END FUNCTION create_boundary_get_dom 
    866    !> @endcode 
    8671186   !------------------------------------------------------------------- 
    8681187   !> @brief 
    869    !> This subroutine 
     1188   !> This subroutine get coordinates over boudnary domain 
     1189   !>  
     1190   !> @author J.Paul 
     1191   !> - November, 2013- Initial Version 
     1192   !> @date September, 2014 - take into account grid point 
     1193   !> 
     1194   !> @param[in] td_coord1 coordinates file structure 
     1195   !> @param[in] td_dom1   boundary domain structure 
     1196   !> @param[in] cd_point  grid point 
     1197   !> @param[out] td_lon1  longitude variable structure 
     1198   !> @param[out] td_lat1  latitude variable structure 
     1199   !------------------------------------------------------------------- 
     1200   SUBROUTINE create_boundary_get_coord( td_coord1, td_dom1, cd_point, & 
     1201   &                                     td_lon1, td_lat1 ) 
     1202 
     1203      IMPLICIT NONE 
     1204      ! Argument 
     1205      TYPE(TMPP)      , INTENT(IN   ) :: td_coord1 
     1206      TYPE(TDOM)      , INTENT(IN   ) :: td_dom1 
     1207      TYPE(TVAR)      , INTENT(  OUT) :: td_lon1 
     1208      TYPE(TVAR)      , INTENT(  OUT) :: td_lat1  
     1209      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_point 
     1210 
     1211      ! local variable 
     1212      TYPE(TMPP)  :: tl_coord1 
     1213       
     1214      CHARACTER(LEN=lc) :: cl_name 
     1215      ! loop indices 
     1216      !---------------------------------------------------------------- 
     1217      !read variables on domain (ugly way to do it, have to work on it) 
     1218      ! init mpp structure 
     1219      tl_coord1=mpp_copy(td_coord1) 
     1220       
     1221      ! open mpp files 
     1222      CALL iom_dom_open(tl_coord1, td_dom1) 
     1223 
     1224      ! read variable value on domain 
     1225      WRITE(cl_name,*) 'longitude_'//TRIM(cd_point) 
     1226      td_lon1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1) 
     1227      WRITE(cl_name,*) 'latitude_'//TRIM(cd_point) 
     1228      td_lat1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1) 
     1229 
     1230      ! close mpp files 
     1231      CALL iom_dom_close(tl_coord1) 
     1232 
     1233      ! clean structure 
     1234      CALL mpp_clean(tl_coord1) 
     1235 
     1236   END SUBROUTINE create_boundary_get_coord 
     1237   !------------------------------------------------------------------- 
     1238   !> @brief 
     1239   !> This subroutine interpolate variable over boundary 
    8701240   !>  
    8711241   !> @details  
     
    8741244   !> - Nov, 2013- Initial Version 
    8751245   !> 
    876    !> @param[in]  
    877    !> @todo  
    878    !------------------------------------------------------------------- 
    879    !> @code 
    880    SUBROUTINE create_boundary_get_coord( td_bathy1, td_dom1, & 
    881    &                                     td_lon1, td_lat1 ) 
    882  
    883       IMPLICIT NONE 
    884  
    885       ! Argument 
    886       TYPE(TFILE), INTENT(IN   ) :: td_bathy1 
    887       TYPE(TDOM) , INTENT(IN   ) :: td_dom1 
    888       TYPE(TVAR) , INTENT(  OUT) :: td_lon1 
    889       TYPE(TVAR) , INTENT(  OUT) :: td_lat1  
    890  
    891       ! local variable 
    892       TYPE(TFILE) :: tl_bathy1 
    893        
    894       TYPE(TMPP)  :: tl_mppbathy1 
    895  
    896       ! loop indices 
    897       !---------------------------------------------------------------- 
    898       !read variables on domain (ugly way to do it, have to work on it) 
    899  
    900       !1 init mpp structure 
    901       tl_bathy1=td_bathy1 
    902       tl_mppbathy1=mpp_init(tl_bathy1) 
    903        
    904       CALL file_clean(tl_bathy1) 
    905  
    906       !2 get processor to be used 
    907       CALL mpp_get_use( tl_mppbathy1, td_dom1 ) 
    908  
    909       !3 open mpp files 
    910       CALL iom_mpp_open(tl_mppbathy1) 
    911  
    912       !4 read variable value on domain 
    913       td_lon1=iom_mpp_read_var(tl_mppbathy1,'longitude',td_dom=td_dom1) 
    914       td_lat1=iom_mpp_read_var(tl_mppbathy1,'latitude' ,td_dom=td_dom1) 
    915  
    916       !5 close mpp files 
    917       CALL iom_mpp_close(tl_mppbathy1) 
    918  
    919       !6 clean structure 
    920       CALL mpp_clean(tl_mppbathy1) 
    921  
    922    END SUBROUTINE create_boundary_get_coord 
    923    !> @endcode 
    924    !------------------------------------------------------------------- 
    925    !> @brief 
    926    !> This subroutine 
    927    !>  
    928    !> @details  
    929    !> 
    930    !> @author J.Paul 
    931    !> - Nov, 2013- Initial Version 
    932    !> 
    933    !> @param[in]  
    934    !> @todo  
    935    !------------------------------------------------------------------- 
    936    !> @code 
    937    SUBROUTINE create_boundary_get_mask( td_level1, td_dom1, & 
    938    &                                    td_var, td_mask ) 
    939  
    940       IMPLICIT NONE 
    941  
    942       ! Argument 
    943       TYPE(TFILE), INTENT(IN   ) :: td_level1 
    944       TYPE(TDOM) , INTENT(IN   ) :: td_dom1 
    945       TYPE(TVAR) , INTENT(IN   ) :: td_var 
    946       TYPE(TVAR) , INTENT(  OUT) :: td_mask  
    947  
    948       ! local variable 
    949       TYPE(TFILE) :: tl_level1 
    950        
    951       TYPE(TMPP)  :: tl_mpplevel1 
    952  
    953       ! loop indices 
    954       !---------------------------------------------------------------- 
    955       !read variables on domain (ugly way to do it, have to work on it) 
    956  
    957       !1 init mpp structure 
    958       tl_level1=td_level1 
    959       tl_mpplevel1=mpp_init(tl_level1) 
    960        
    961       CALL file_clean(tl_level1) 
    962  
    963       !2 get processor to be used 
    964       CALL mpp_get_use( tl_mpplevel1, td_dom1 ) 
    965  
    966       !3 open mpp files 
    967       CALL iom_mpp_open(tl_mpplevel1) 
    968  
    969       !4 read variable value on domain 
    970       SELECT CASE(TRIM(td_var%c_point)) 
    971       CASE('T') 
    972          td_mask=iom_mpp_read_var(tl_mpplevel1,'tlevel',td_dom=td_dom1) 
    973       CASE('U') 
    974          td_mask=iom_mpp_read_var(tl_mpplevel1,'ulevel',td_dom=td_dom1) 
    975       CASE('V') 
    976          td_mask=iom_mpp_read_var(tl_mpplevel1,'vlevel',td_dom=td_dom1) 
    977       CASE('F') 
    978          td_mask=iom_mpp_read_var(tl_mpplevel1,'flevel',td_dom=td_dom1) 
    979       END SELECT 
    980  
    981       !5 close mpp files 
    982       CALL iom_mpp_close(tl_mpplevel1) 
    983  
    984       !6 clean structure 
    985       CALL mpp_clean(tl_mpplevel1) 
    986  
    987    END SUBROUTINE create_boundary_get_mask 
    988    !> @endcode 
    989 !   !------------------------------------------------------------------- 
    990 !   !> @brief 
    991 !   !> This subroutine 
    992 !   !>  
    993 !   !> @details  
    994 !   !> 
    995 !   !> @author J.Paul 
    996 !   !> - Nov, 2013- Initial Version 
    997 !   !> 
    998 !   !> @param[in]  
    999 !   !> @todo  
    1000 !   !------------------------------------------------------------------- 
    1001 !   !> @code 
    1002 !   SUBROUTINE create_boundary_get_var( td_var, td_bdy,      & 
    1003 !   &                                   td_coord0, td_dom0,  & 
    1004 !   &                                   td_mask,             & 
    1005 !   &                                   id_rhoi, id_rhoj ) 
    1006 ! 
    1007 !      IMPLICIT NONE 
    1008 ! 
    1009 !      ! Argument 
    1010 !      TYPE(TVAR) , INTENT(INOUT) :: td_var 
    1011 !      TYPE(TBDY) , INTENT(IN   ) :: td_bdy 
    1012 !      TYPE(TFILE), INTENT(IN   ) :: td_coord0 
    1013 !      TYPE(TDOM) , INTENT(IN   ) :: td_dom0 
    1014 !      TYPE(TVAR) , INTENT(IN   ) :: td_mask 
    1015 !      INTEGER(I4), INTENT(IN   ) :: id_rhoi 
    1016 !      INTEGER(I4), INTENT(IN   ) :: id_rhoj 
    1017 ! 
    1018 !      ! local variable 
    1019 !      TYPE(TVAR)  :: tl_var0 
    1020 ! 
    1021 !      TYPE(TDOM)  :: tl_dom0 
    1022 ! 
    1023 !      TYPE(TFILE) :: tl_file0 
    1024 ! 
    1025 !      TYPE(TMPP)  :: tl_mppfile0 
    1026 ! 
    1027 !      ! loop indices 
    1028 !      INTEGER(i4) :: jk 
    1029 !      INTEGER(i4) :: jl 
    1030 !      !---------------------------------------------------------------- 
    1031 ! 
    1032 !      CALL logger_debug("CREATE BOUNDARY INTERP: read coarse grid"// TRIM(td_var%c_file) ) 
    1033 !      !1- read coarse grid variable on domain 
    1034 !      tl_file0=file_init( TRIM(td_var%c_file) ) 
    1035 ! 
    1036 !      !2- init 
    1037 !      tl_dom0=td_dom0 
    1038 ! 
    1039 !      !3- add extra band (if possible) to compute interpolation 
    1040 !      CALL dom_add_extra(tl_dom0) 
    1041 ! 
    1042 !      !4- read variables on domain (ugly way to do it, have to work on it) 
    1043 !      !4-1 init mpp structure 
    1044 !      tl_mppfile0=mpp_init(tl_file0) 
    1045 !  
    1046 !      CALL file_clean(tl_file0) 
    1047 ! 
    1048 !      !4-2 get processor to be used 
    1049 !      CALL mpp_get_use( tl_mppfile0, tl_dom0 ) 
    1050 ! 
    1051 !      !4-3 open mpp files 
    1052 !      CALL iom_mpp_open(tl_mppfile0) 
    1053 ! 
    1054 !      ! check file dimension 
    1055 !      IF( ANY(tl_mppfile0%t_dim(1:2)%i_len /= td_coord0%t_dim(1:2)%i_len) )THEN 
    1056 !         CALL logger_error("CREATE BOUNDARY INTERP: dimension of file "//& 
    1057 !         &  TRIM(tl_mppfile0%c_name)//" not conform to those of "//& 
    1058 !         &  TRIM(td_coord0%c_name)) 
    1059 !      ELSE 
    1060 ! 
    1061 !         !4-4 read variable value on domain 
    1062 !         tl_var0=iom_mpp_read_var( tl_mppfile0, TRIM(td_var%c_name), & 
    1063 !         &                         td_dom=tl_dom0 ) 
    1064 ! 
    1065 !         !5- work on variable 
    1066 !         CALL create_boundary_interp(tl_var0, id_rhoi, id_rhoj ) 
    1067 !          
    1068 !         !6- remove extraband added to domain 
    1069 !         CALL dom_del_extra( tl_var0, tl_dom0, id_rhoi, id_rhoj ) 
    1070 ! 
    1071 !         !6-1 remove extraband added to domain 
    1072 !         CALL dom_clean_extra( tl_dom0 )          
    1073 ! 
    1074 !         !7- keep only useful point (width)  
    1075 !         ! interpolation could create more point than necessary 
    1076 !         CALL boundary_clean_interp(tl_var0, td_bdy ) 
    1077 ! 
    1078 !         !8- forced min and max value 
    1079 !         CALL var_limit_value(tl_var0) 
    1080 ! 
    1081 !         !9- filter 
    1082 !         CALL filter_fill_value(tl_var0) 
    1083 ! 
    1084 !         td_var=tl_var0 
    1085 ! 
    1086 !         CALL var_clean(tl_var0) 
    1087 !      ENDIF 
    1088 ! 
    1089 !      !4-5 close mpp files 
    1090 !      CALL iom_mpp_close(tl_mppfile0) 
    1091 ! 
    1092 !      !4-6 clean structure 
    1093 !      CALL mpp_clean(tl_mppfile0) 
    1094 !       
    1095 !      !5- apply mask 
    1096 !      DO jl=1,td_var%t_dim(4)%i_len 
    1097 !         DO jk=1,td_var%t_dim(3)%i_len 
    1098 !            WHERE( td_mask%d_value(:,:,1,1) < jk ) 
    1099 !               td_var%d_value(:,:,jk,jl)=td_var%d_fill 
    1100 !            END WHERE 
    1101 !         ENDDO 
    1102 !      ENDDO 
    1103 ! 
    1104 !   END SUBROUTINE create_boundary_get_var 
    1105 !   !> @endcode 
    1106    !------------------------------------------------------------------- 
    1107    !> @brief 
    1108    !> This subroutine 
    1109    !>  
    1110    !> @details  
    1111    !> 
    1112    !> @author J.Paul 
    1113    !> - Nov, 2013- Initial Version 
    1114    !> 
    1115    !> @param[in]  
    1116    !> @todo  
    1117    !------------------------------------------------------------------- 
    1118    !> @code 
     1246   !> @param[inout] td_var variable structure  
     1247   !> @param[in] id_rho    array of refinment factor 
     1248   !> @param[in] id_offset array of offset between fine and coarse grid 
     1249   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext) 
     1250   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext) 
     1251   !------------------------------------------------------------------- 
    11191252   SUBROUTINE create_boundary_interp( td_var,           & 
    11201253   &                                  id_rho,           & 
     
    11341267 
    11351268      ! local variable 
    1136       TYPE(TVAR)  :: tl_var 
    1137  
    11381269      INTEGER(i4) :: il_iext 
    11391270      INTEGER(i4) :: il_jext 
    11401271      ! loop indices 
    11411272      !---------------------------------------------------------------- 
    1142  
    1143       ! copy variable 
    1144       tl_var=td_var 
    11451273 
    11461274      !WARNING: at least two extrabands are required for cubic interpolation 
     
    11631291      ENDIF 
    11641292 
    1165       !2- work on variable 
    1166       !2-0 add extraband 
    1167       CALL extrap_add_extrabands(tl_var, il_iext, il_jext) 
    1168  
    1169       !2-1 extrapolate variable 
    1170       CALL extrap_fill_value( tl_var, id_iext=il_iext, id_jext=il_jext ) 
    1171  
    1172       !2-2 interpolate Bathymetry 
    1173       CALL interp_fill_value( tl_var, id_rho(:), & 
     1293      ! work on variable 
     1294      ! add extraband 
     1295      CALL extrap_add_extrabands(td_var, il_iext, il_jext) 
     1296 
     1297      ! extrapolate variable 
     1298      CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext ) 
     1299 
     1300      ! interpolate Bathymetry 
     1301      CALL interp_fill_value( td_var, id_rho(:), & 
    11741302      &                       id_offset=id_offset(:,:) ) 
    11751303 
    1176       !2-3 remove extraband 
    1177       CALL extrap_del_extrabands(tl_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 
    1178  
    1179       !3- save result 
    1180       td_var=tl_var 
    1181  
    1182       ! clean variable structure 
    1183       CALL var_clean(tl_var) 
     1304      ! remove extraband 
     1305      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 
    11841306 
    11851307   END SUBROUTINE create_boundary_interp 
    1186    !> @endcode 
    11871308   !------------------------------------------------------------------- 
    11881309   !> @brief 
     
    11921313   !> A variable is create with the same name that the input variable,  
    11931314   !> and with dimension of the coordinate file.  
    1194    !> Then the variable table of value is split into equal subdomain. 
     1315   !> Then the variable array of value is split into equal subdomain. 
    11951316   !> Each subdomain is fill with the linked value of the matrix. 
    11961317   !> 
    11971318   !> @author J.Paul 
    1198    !> - Nov, 2013- Initial Version 
     1319   !> - November, 2013- Initial Version 
    11991320   !> 
    1200    !> @param[in] td_var : variable structure  
    1201    !> @param[in] td_dom : domain structure  
    1202    !> @param[in] td_coord : coordinate  
     1321   !> @param[in] td_var   variable structure  
     1322   !> @param[in] td_dom   domain structure  
     1323   !> @param[in] id_nlevel number of levels  
    12031324   !> @return variable structure  
    12041325   !------------------------------------------------------------------- 
    1205    !> @code 
    1206    FUNCTION create_bdy_matrix(td_var, td_dom, td_coord) 
     1326   FUNCTION create_boundary_matrix(td_var, td_dom, id_nlevel) 
    12071327      IMPLICIT NONE 
    12081328      ! Argument 
    1209       TYPE(TVAR) , INTENT(IN) :: td_var 
    1210       TYPE(TDOM) , INTENT(IN) :: td_dom 
    1211       TYPE(TFILE), INTENT(IN) :: td_coord 
     1329      TYPE(TVAR) ,               INTENT(IN) :: td_var 
     1330      TYPE(TDOM) ,               INTENT(IN) :: td_dom 
     1331      INTEGER(i4),               INTENT(IN) :: id_nlevel 
    12121332 
    12131333      ! function 
    1214       TYPE(TVAR) :: create_bdy_matrix 
     1334      TYPE(TVAR) :: create_boundary_matrix 
    12151335 
    12161336      ! local variable 
    1217       INTEGER(i4)                                        :: il_ighost 
    1218       INTEGER(i4)                                        :: il_jghost 
    1219       INTEGER(i4)      , DIMENSION(2)                    :: il_xghost 
    12201337      INTEGER(i4)      , DIMENSION(3)                    :: il_dim 
    12211338      INTEGER(i4)      , DIMENSION(3)                    :: il_size 
     
    12281345      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 
    12291346 
    1230       TYPE(TVAR)                                         :: tl_lon 
    1231       TYPE(TVAR)                                         :: tl_lat 
    1232       TYPE(TVAR)                                         :: tl_var 
    12331347      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim 
    12341348 
     
    12391353      !---------------------------------------------------------------- 
    12401354 
    1241       !1- read output grid 
    1242       tl_lon=iom_read_var(td_coord,'longitude') 
    1243       tl_lat=iom_read_var(td_coord,'latitude') 
    1244  
    1245       !2- look for ghost cell 
    1246       il_xghost(:)=grid_get_ghost( tl_lon, tl_lat ) 
    1247  
    1248       il_ighost=il_xghost(1)*ig_ghost 
    1249       il_jghost=il_xghost(2)*ig_ghost 
    1250        
    1251       !3- write value on grid 
    1252       !3-1 get matrix dimension 
     1355      ! write value on grid 
     1356      ! get matrix dimension 
    12531357      il_dim(:)=td_var%t_dim(1:3)%i_len 
    1254       !3-2 output dimension 
    1255       tl_dim(:)=tl_lon%t_dim(:) 
    1256  
    1257       ! remove ghost cell 
    1258       tl_dim(1)%i_len=tl_dim(1)%i_len - 2*il_xghost(1)*ig_ghost 
    1259       tl_dim(2)%i_len=tl_dim(2)%i_len - 2*il_xghost(2)*ig_ghost 
    1260  
    1261       !3-3 split output domain in N subdomain depending of matrix dimension  
     1358 
     1359      tl_dim(jp_I:jp_J)=dim_copy(td_dom%t_dim(jp_I:jp_J)) 
     1360      tl_dim(jp_K)%i_len=id_nlevel 
     1361 
     1362      ! split output domain in N subdomain depending of matrix dimension  
    12621363      il_size(:) = tl_dim(1:3)%i_len / il_dim(:) 
    12631364      il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:)) 
     
    12711372      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1) 
    12721373       
    1273  
    12741374      ALLOCATE( il_jshape(il_dim(2)+1) ) 
    12751375      il_jshape(:)=0 
     
    12881388      il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3) 
    12891389 
    1290       !3-3 write ouput table of value  
     1390      ! write ouput array of value  
    12911391      ALLOCATE(dl_value( tl_dim(1)%i_len, & 
    12921392      &                  tl_dim(2)%i_len, & 
     
    13091409      ENDDO 
    13101410 
    1311       !3-4 initialise variable with value 
    1312       tl_var=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:)) 
     1411      ! initialise variable with value 
     1412      create_boundary_matrix=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:)) 
    13131413 
    13141414      DEALLOCATE(dl_value) 
    13151415 
    1316       !4- add ghost cell 
    1317       CALL grid_add_ghost(tl_var,il_ighost,il_jghost) 
    1318  
    1319       !5- save result 
    1320       create_bdy_matrix=tl_var 
    1321  
    1322    END FUNCTION create_bdy_matrix 
    1323    !> @endcode 
     1416   END FUNCTION create_boundary_matrix 
    13241417   !------------------------------------------------------------------- 
    13251418   !> @brief 
    1326    !> This subroutine 
     1419   !> This subroutine use mask to filled land point with _FillValue 
    13271420   !>  
    13281421   !> @details  
    13291422   !> 
    13301423   !> @author J.Paul 
    1331    !> - Nov, 2013- Initial Version 
     1424   !> - November, 2013- Initial Version 
    13321425   !> 
    1333    !> @param[in]  
    1334    !> @todo  
    1335    !------------------------------------------------------------------- 
    1336    !> @code 
    1337    SUBROUTINE create_bdy_use_mask( td_var, td_mask ) 
     1426   !> @param[inout] td_var variable structure  
     1427   !> @param[in] td_mask   mask variable structure 
     1428   !------------------------------------------------------------------- 
     1429   SUBROUTINE create_boundary_use_mask( td_var, td_mask ) 
    13381430 
    13391431      IMPLICIT NONE 
    13401432 
    13411433      ! Argument 
    1342       TYPE(TVAR)              , INTENT(INOUT) :: td_var 
    1343       TYPE(TVAR), DIMENSION(:), INTENT(IN   ) :: td_mask 
     1434      TYPE(TVAR), INTENT(INOUT) :: td_var 
     1435      TYPE(TVAR), INTENT(IN   ) :: td_mask 
    13441436 
    13451437      ! local variable 
     
    13511443      !---------------------------------------------------------------- 
    13521444 
     1445      IF( ANY(td_var%t_dim(1:2)%i_len /= & 
     1446      &       td_mask%t_dim(1:2)%i_len) )THEN 
     1447         CALL logger_debug("     mask dimension ( "//& 
     1448         &              TRIM(fct_str(td_mask%t_dim(1)%i_len))//","//& 
     1449         &              TRIM(fct_str(td_mask%t_dim(2)%i_len))//")" ) 
     1450         CALL logger_debug(" variable dimension ( "//& 
     1451         &              TRIM(fct_str(td_var%t_dim(1)%i_len))//","//& 
     1452         &              TRIM(fct_str(td_var%t_dim(2)%i_len))//")" ) 
     1453         CALL logger_fatal("CREATE BOUNDARY USE MASK: mask and "//& 
     1454         &                 "variable dimension differ."   ) 
     1455      ENDIF 
     1456 
    13531457      ALLOCATE( il_mask(td_var%t_dim(1)%i_len, & 
    13541458      &                 td_var%t_dim(2)%i_len) ) 
    13551459 
    1356       SELECT CASE(TRIM(td_var%c_point)) 
    1357       CASE('T') 
    1358          il_mask(:,:)=INT(td_mask(jp_T)%d_value(:,:,1,1)) 
    1359       CASE('U') 
    1360          il_mask(:,:)=INT(td_mask(jp_U)%d_value(:,:,1,1)) 
    1361       CASE('V') 
    1362          il_mask(:,:)=INT(td_mask(jp_V)%d_value(:,:,1,1)) 
    1363       CASE('F') 
    1364          il_mask(:,:)=INT(td_mask(jp_F)%d_value(:,:,1,1)) 
    1365       END SELECT 
     1460      il_mask(:,:)=INT(td_mask%d_value(:,:,1,1)) 
    13661461 
    13671462      DO jl=1,td_var%t_dim(4)%i_len 
     
    13721467 
    13731468      DEALLOCATE( il_mask ) 
    1374    END SUBROUTINE create_bdy_use_mask 
    1375    !> @endcode 
     1469 
     1470   END SUBROUTINE create_boundary_use_mask 
    13761471   !------------------------------------------------------------------- 
    13771472   !> @brief 
     1473   !> This function extract level over domain on each grid point, and return 
     1474   !> array of variable structure 
     1475   !> 
     1476   !> @author J.Paul 
     1477   !> - November, 2013- Initial Version 
     1478   !> 
     1479   !> @param[in] td_level  array of level variable structure 
     1480   !> @param[in] td_dom    array of domain structure 
     1481   !> @return array of variable structure 
     1482   !------------------------------------------------------------------- 
     1483   FUNCTION create_boundary_get_level(td_level, td_dom) 
     1484      IMPLICIT NONE 
     1485      ! Argument 
     1486      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level 
     1487      TYPE(TDOM), DIMENSION(:), INTENT(IN) :: td_dom 
     1488 
     1489      ! function 
     1490      TYPE(TVAR), DIMENSION(ip_npoint) :: create_boundary_get_level 
     1491 
     1492      ! local variable 
     1493      TYPE(TVAR), DIMENSION(ip_npoint) :: tl_var 
     1494 
     1495      ! loop indices 
     1496      INTEGER(i4) :: ji 
     1497      !---------------------------------------------------------------- 
     1498 
     1499      IF( SIZE(td_level(:)) /= ip_npoint .OR. & 
     1500      &   SIZE(td_dom(:)) /= ip_npoint )THEN 
     1501         CALL logger_error("CREATE BDY GET LEVEL: invalid dimension. "//& 
     1502         &  "check input array of level and domain.") 
     1503      ELSE 
     1504 
     1505         DO ji=1,ip_npoint 
     1506 
     1507            tl_var(ji)=var_copy(td_level(ji)) 
     1508 
     1509            IF( ASSOCIATED(tl_var(ji)%d_value) ) DEALLOCATE(tl_var(ji)%d_value) 
     1510 
     1511            tl_var(ji)%t_dim(1)%i_len=td_dom(ji)%t_dim(1)%i_len 
     1512            tl_var(ji)%t_dim(2)%i_len=td_dom(ji)%t_dim(2)%i_len 
     1513            ALLOCATE(tl_var(ji)%d_value(tl_var(ji)%t_dim(1)%i_len, & 
     1514            &                           tl_var(ji)%t_dim(2)%i_len, & 
     1515            &                           tl_var(ji)%t_dim(3)%i_len, & 
     1516            &                           tl_var(ji)%t_dim(4)%i_len) ) 
     1517 
     1518            tl_var(ji)%d_value(:,:,:,:) = & 
     1519            &  td_level(ji)%d_value( td_dom(ji)%i_imin:td_dom(ji)%i_imax, & 
     1520            &                        td_dom(ji)%i_jmin:td_dom(ji)%i_jmax, :, : ) 
     1521 
     1522         ENDDO 
     1523         ! save result 
     1524         create_boundary_get_level(:)=var_copy(tl_var(:)) 
     1525 
     1526         ! clean 
     1527         CALL var_clean(tl_var(:)) 
     1528 
     1529      ENDIF 
     1530   END FUNCTION create_boundary_get_level 
     1531   !------------------------------------------------------------------- 
     1532   !> @brief 
     1533   !> This subroutine get depth variable value in an open mpp structure 
     1534   !> and check if agree with already input depth variable. 
    13781535   !>  
    13791536   !> @details  
    13801537   !> 
    13811538   !> @author J.Paul 
    1382    !> - 2013- Initial Version 
     1539   !> - November, 2014- Initial Version 
    13831540   !> 
    1384    !------------------------------------------------------------------- 
    1385    !> @code 
    1386    FUNCTION create_bdy_get_level(td_level, td_dom) 
     1541   !> @param[in] td_mpp       mpp structure 
     1542   !> @param[inout] td_depth  depth variable structure  
     1543   !------------------------------------------------------------------- 
     1544   SUBROUTINE create_boundary_check_depth( td_mpp, td_depth ) 
     1545 
    13871546      IMPLICIT NONE 
     1547 
    13881548      ! Argument 
    1389       TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level 
    1390       TYPE(TDOM)              , INTENT(IN) :: td_dom 
    1391  
    1392       ! function 
    1393       TYPE(TVAR), DIMENSION(ig_npoint) :: create_bdy_get_level 
     1549      TYPE(TMPP) , INTENT(IN   ) :: td_mpp 
     1550      TYPE(TVAR) , INTENT(INOUT) :: td_depth 
    13941551 
    13951552      ! local variable 
    1396       TYPE(TVAR), DIMENSION(ig_npoint) :: tl_var 
    1397  
     1553      INTEGER(i4) :: il_varid 
     1554      TYPE(TVAR)  :: tl_depth 
    13981555      ! loop indices 
    1399       INTEGER(i4) :: ji 
    14001556      !---------------------------------------------------------------- 
    14011557 
    1402       IF( SIZE(td_level(:)) /= ig_npoint )THEN 
    1403          CALL logger_error("CREATE BDY GET LEVEL: invalid dimension. "//& 
    1404          &  "check input table of level.") 
    1405       ELSE 
    1406  
    1407          !tl_var(1:ig_npoint)=td_level(1:ig_npoint) 
    1408          create_bdy_get_level(:)=tl_var(:) 
    1409          DO ji=1,ig_npoint 
    1410  
    1411          tl_var(ji)=td_level(ji) 
    1412  
    1413             IF( ASSOCIATED(tl_var(ji)%d_value) ) DEALLOCATE( tl_var(ji)%d_value ) 
    1414  
    1415             tl_var(ji)%t_dim(1)%i_len=td_dom%t_dim(1)%i_len 
    1416             tl_var(ji)%t_dim(2)%i_len=td_dom%t_dim(2)%i_len 
    1417             ALLOCATE(tl_var(ji)%d_value(tl_var(ji)%t_dim(1)%i_len, & 
    1418             &                           tl_var(ji)%t_dim(2)%i_len, & 
    1419             &                           tl_var(ji)%t_dim(3)%i_len, & 
    1420             &                           tl_var(ji)%t_dim(4)%i_len) ) 
    1421  
    1422             tl_var(ji)%d_value(:,:,:,:) = & 
    1423             &  td_level(ji)%d_value( td_dom%i_imin:td_dom%i_imax, & 
    1424             &                        td_dom%i_jmin:td_dom%i_jmax, :, : ) 
    1425  
    1426          ENDDO 
    1427          !4 save result 
    1428          create_bdy_get_level(:)=tl_var(:) 
     1558      ! get or check depth value 
     1559      IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN 
     1560 
     1561         il_varid=td_mpp%t_proc(1)%i_depthid 
     1562         IF( ASSOCIATED(td_depth%d_value) )THEN 
     1563 
     1564            tl_depth=iom_mpp_read_var(td_mpp, il_varid) 
     1565            IF( ANY( td_depth%d_value(:,:,:,:) /= & 
     1566            &        tl_depth%d_value(:,:,:,:) ) )THEN 
     1567 
     1568               CALL logger_fatal("CREATE BOUNDARY: depth value from "//& 
     1569               &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
     1570               &  " to those from former file(s).") 
     1571 
     1572            ENDIF 
     1573            CALL var_clean(tl_depth) 
     1574 
     1575         ELSE 
     1576            td_depth=iom_mpp_read_var(td_mpp,il_varid) 
     1577         ENDIF 
    14291578 
    14301579      ENDIF 
    1431    END FUNCTION create_bdy_get_level 
    1432    !> @endcode 
     1580       
     1581   END SUBROUTINE create_boundary_check_depth 
     1582   !------------------------------------------------------------------- 
     1583   !> @brief 
     1584   !> This subroutine get date and time in an open mpp structure 
     1585   !> and check if agree with date and time already read. 
     1586   !>  
     1587   !> @details  
     1588   !> 
     1589   !> @author J.Paul 
     1590   !> - November, 2014- Initial Version 
     1591   !> 
     1592   !> @param[in] td_mpp      mpp structure 
     1593   !> @param[inout] td_time  time variable structure  
     1594   !------------------------------------------------------------------- 
     1595   SUBROUTINE create_boundary_check_time( td_mpp, td_time ) 
     1596 
     1597      IMPLICIT NONE 
     1598 
     1599      ! Argument 
     1600      TYPE(TMPP), INTENT(IN   ) :: td_mpp 
     1601      TYPE(TVAR), INTENT(INOUT) :: td_time 
     1602 
     1603      ! local variable 
     1604      INTEGER(i4) :: il_varid 
     1605      TYPE(TVAR)  :: tl_time 
     1606 
     1607      TYPE(TDATE) :: tl_date1 
     1608      TYPE(TDATE) :: tl_date2 
     1609      ! loop indices 
     1610      !---------------------------------------------------------------- 
     1611 
     1612      ! get or check depth value 
     1613      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 
     1614 
     1615         il_varid=td_mpp%t_proc(1)%i_timeid 
     1616         IF( ASSOCIATED(td_time%d_value) )THEN 
     1617 
     1618            tl_time=iom_mpp_read_var(td_mpp, il_varid) 
     1619 
     1620            tl_date1=var_to_date(td_time) 
     1621            tl_date2=var_to_date(tl_time) 
     1622            IF( tl_date1 - tl_date2 /= 0 )THEN 
     1623 
     1624               CALL logger_fatal("CREATE BOUNDARY: date from "//& 
     1625               &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
     1626               &  " to those from former file(s).") 
     1627 
     1628            ENDIF 
     1629            CALL var_clean(tl_time) 
     1630 
     1631         ELSE 
     1632            td_time=iom_mpp_read_var(td_mpp,il_varid) 
     1633         ENDIF 
     1634 
     1635      ENDIF 
     1636       
     1637   END SUBROUTINE create_boundary_check_time 
    14331638END PROGRAM create_boundary 
Note: See TracChangeset for help on using the changeset viewer.