New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5600 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/create_restart.f90 – NEMO

Ignore:
Timestamp:
2015-07-15T17:46:12+02:00 (9 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_restart.f90

    r4213 r5600  
    77! 
    88! DESCRIPTION: 
     9!> @file 
    910!> @brief  
    1011!> This program create restart file. 
    1112!> 
    1213!> @details 
    13 !> Variables are read from restart file, or standard output. 
    14 !> Then theses variables are interpolated on fine grid.  
    15 !> Finally table are split over new decomposition.  
    16 !> 
    17 !> @author 
    18 !> J.Paul 
     14!> @section sec1 method 
     15!> Variables could be extracted from fine grid file, interpolated from coarse 
     16!> grid file or restart file, or manually written.<br/>  
     17!> Then they are split over new decomposition.  
     18!> @note  
     19!>    method could be different for each variable. 
     20!> 
     21!> @section sec2 how to 
     22!>    to create restart file:<br/> 
     23!> @code{.sh} 
     24!>    ./SIREN/bin/create_restart create_restart.nam 
     25!> @endcode 
     26!>     
     27!>    create_restart.nam comprise 9 namelists:<br/> 
     28!>       - logger namelist (namlog) 
     29!>       - config namelist (namcfg) 
     30!>       - coarse grid namelist (namcrs) 
     31!>       - fine grid namelist (namfin) 
     32!>       - vertical grid namelist (namzgr) 
     33!>       - partial step namelist (namzps) 
     34!>       - variable namelist (namvar) 
     35!>       - nesting namelist (namnst) 
     36!>       - output namelist (namout) 
     37!>     
     38!>    @note  
     39!>       All namelists have to be in file create_restart.nam  
     40!>       however variables of those namelists are all optional. 
     41!> 
     42!>    * _logger namelist (namlog)_:<br/> 
     43!>       - cn_logfile   : log filename 
     44!>       - cn_verbosity : verbosity ('trace','debug','info', 
     45!> 'warning','error','fatal') 
     46!>       - in_maxerror  : maximum number of error allowed 
     47!> 
     48!>    * _config namelist (namcfg)_:<br/> 
     49!>       - cn_varcfg : variable configuration file 
     50!> (see ./SIREN/cfg/variable.cfg) 
     51!> 
     52!>    * _coarse grid namelist (namcrs):<br/> 
     53!>       - cn_coord0 : coordinate file 
     54!>       - in_perio0 : NEMO periodicity index (see Model Boundary Condition in 
     55!> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals)) 
     56!> 
     57!>    * _fine grid namelist (namfin)_:<br/> 
     58!>       - cn_coord1 : coordinate file 
     59!>       - cn_bathy1 : bathymetry file 
     60!>       - in_perio1 : NEMO periodicity index 
     61!>       - in_extrap : number of land point to be extrapolated  
     62!>       before writing file 
     63!> 
     64!>    * _vertical grid namelist (namzgr)_:<br/> 
     65!>       - dn_pp_to_be_computed  : 
     66!>       - dn_ppsur              : 
     67!>       - dn_ppa0               : 
     68!>       - dn_ppa1               : 
     69!>       - dn_ppa2               :  
     70!>       - dn_ppkth              : 
     71!>       - dn_ppkth2             : 
     72!>       - dn_ppacr              : 
     73!>       - dn_ppacr2             : 
     74!>       - dn_ppdzmin            : 
     75!>       - dn_pphmax             : 
     76!>       - in_nlevel             : number of vertical level 
     77!> 
     78!>    * _partial step namelist (namzps)_:<br/> 
     79!>       - dn_e3zps_min          : 
     80!>       - dn_e3zps_rat          :  
     81!> 
     82!>    * _variable namelist (namvar)_:<br/> 
     83!>       - cn_varinfo : list of variable and extra information about request(s)  
     84!>       to be used.<br/> 
     85!>          each elements of *cn_varinfo* is a string character.<br/> 
     86!>          it is composed of the variable name follow by ':',  
     87!>          then request(s) to be used on this variable.<br/>  
     88!>          request could be: 
     89!>             - interpolation method 
     90!>             - extrapolation method 
     91!>             - filter method 
     92!>             - > minimum value 
     93!>             - < maximum value 
     94!> 
     95!>             requests must be separated by ';'.<br/> 
     96!>             order of requests does not matter.<br/> 
     97!> 
     98!>          informations about available method could be find in @ref interp, 
     99!>          @ref extrap and @ref filter.<br/> 
     100!>          Example: 'votemper: linear; hann; dist_weight','vosaline: cubic' 
     101!>          @note  
     102!>             If you do not specify a method which is required,  
     103!>             default one is apply. 
     104!>       - cn_varfile : list of variable, and corresponding file<br/>  
     105!>          *cn_varfile* is the path and filename of the file where find 
     106!>          variable.<br/> 
     107!>          @note  
     108!>             *cn_varfile* could be a matrix of value, if you want to filled 
     109!>             manually variable value.<br/> 
     110!>             the variable array of value is split into equal subdomain.<br/> 
     111!>             Each subdomain is filled with the corresponding value  
     112!>             of the matrix.<br/>           
     113!>             separators used to defined matrix are: 
     114!>                - ',' for line 
     115!>                - '/' for row 
     116!>                - '\' for level<br/> 
     117!>                Example:<br/> 
     118!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc} 
     119!>                                         3 & 2 & 3 \\ 
     120!>                                         1 & 4 & 5 \end{array} \right) @f$ 
     121!> 
     122!>          Examples:  
     123!>             - 'votemper:gridT.nc', 'vozocrtx:gridU.nc' 
     124!>             - 'votemper:10\25', 'vozocrtx:gridU.nc' 
     125!> 
     126!>             to get all variable from one file: 
     127!>             - 'all:restart.dimg' 
     128!> 
     129!>    * _nesting namelist (namnst)_:<br/> 
     130!>       - in_rhoi  : refinement factor in i-direction 
     131!>       - in_rhoj  : refinement factor in j-direction 
     132!>       @note  
     133!>          coarse grid indices will be deduced from fine grid 
     134!>          coordinate file. 
     135!> 
     136!>    * _output namelist (namout)_:<br/> 
     137!>       - cn_fileout : output file 
     138!>       - in_nproc  : total number of processor to be used 
     139!>       - in_niproc : i-direction number of processor 
     140!>       - in_njproc : j-direction numebr of processor 
     141!>       - cn_type   : output format ('dimg', 'cdf') 
     142!> 
     143!> @author J.Paul 
    19144! REVISION HISTORY: 
    20 !> @date Nov, 2013 - Initial Version 
    21 ! 
     145!> @date November, 2013 - Initial Version 
     146!> @date September, 2014 
     147!> - add header for user 
     148!> - offset computed considering grid point 
     149!> - add attributes in output variable 
     150!> 
    22151!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    23 !> 
    24 !> @todo 
    25 !> - add attributes indices and refinement in output file 
    26 !> - check fileout exist at the beginning 
    27152!---------------------------------------------------------------------- 
    28 !> @code 
    29153PROGRAM create_restart 
    30154 
    31 !   USE netcdf                         ! nf90 library 
    32155   USE global                          ! global variable 
    33156   USE kind                            ! F90 kind parameter 
     
    41164   USE multi                           ! multi file manager 
    42165   USE iom                             ! I/O manager 
    43    USE dom                             ! domain manager 
    44166   USE grid                            ! grid manager 
    45167   USE vgrid                           ! vertical grid manager 
     
    48170   USE filter                          ! filter manager 
    49171   USE mpp                             ! MPP manager 
     172   USE dom                             ! domain manager 
    50173   USE iom_mpp                         ! MPP I/O manager 
     174   USE iom_dom                         ! DOM I/O manager 
    51175 
    52176   IMPLICIT NONE 
     
    58182   CHARACTER(LEN=lc)                                  :: cl_name 
    59183   CHARACTER(LEN=lc)                                  :: cl_data 
     184   CHARACTER(LEN=lc)                                  :: cl_fileout  
    60185 
    61186   INTEGER(i4)                                        :: il_narg 
    62187   INTEGER(i4)                                        :: il_status 
    63188   INTEGER(i4)                                        :: il_fileid 
     189   INTEGER(i4)                                        :: il_nvar 
    64190   INTEGER(i4)                                        :: il_attid 
     191   INTEGER(i4)                                        :: il_imin1 
     192   INTEGER(i4)                                        :: il_imax1 
     193   INTEGER(i4)                                        :: il_jmin1 
     194   INTEGER(i4)                                        :: il_jmax1 
    65195   INTEGER(i4)                                        :: il_imin0 
    66196   INTEGER(i4)                                        :: il_imax0 
    67197   INTEGER(i4)                                        :: il_jmin0 
    68198   INTEGER(i4)                                        :: il_jmax0 
     199   INTEGER(i4)                                        :: il_index 
    69200   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho 
    70    INTEGER(i4)      , DIMENSION(2                  :: il_xghost 
     201   INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost 
    71202   INTEGER(i4)      , DIMENSION(2,2)                  :: il_offset 
    72    INTEGER(i4)      , DIMENSION(2,2,2)                :: il_ind 
     203   INTEGER(i4)      , DIMENSION(2,2                :: il_ind 
    73204 
    74205   LOGICAL                                            :: ll_exist 
    75  
    76    TYPE(TFILE)                                        :: tl_coord0 
    77    TYPE(TFILE)                                        :: tl_coord1 
    78    TYPE(TFILE)                                        :: tl_bathy1 
    79    TYPE(TFILE)                                        :: tl_file 
    80206 
    81207   TYPE(TDOM)                                         :: tl_dom1 
     
    88214   TYPE(TVAR)                                         :: tl_lon 
    89215   TYPE(TVAR)                                         :: tl_lat 
    90    TYPE(TVAR)                                         :: tl_tmp 
    91216   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_var 
    92217   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_level 
     
    94219   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim 
    95220 
     221   TYPE(TMPP)                                         :: tl_coord0 
     222   TYPE(TMPP)                                         :: tl_coord1 
     223   TYPE(TMPP)                                         :: tl_bathy1 
    96224   TYPE(TMPP)                                         :: tl_mpp 
    97225   TYPE(TMPP)                                         :: tl_mppout 
     226 
    98227   TYPE(TMULTI)                                       :: tl_multi 
    99228 
     
    104233 
    105234   ! namelist variable 
     235   ! namlog 
    106236   CHARACTER(LEN=lc) :: cn_logfile = 'create_restart.log'  
    107237   CHARACTER(LEN=lc) :: cn_verbosity = 'warning'  
    108  
     238   INTEGER(i4)       :: in_maxerror = 5 
     239 
     240   ! namcfg 
    109241   CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg'  
    110242 
     243   ! namcrs 
    111244   CHARACTER(LEN=lc) :: cn_coord0 = ''  
    112245   INTEGER(i4)       :: in_perio0 = -1 
    113246 
     247   ! namfin 
    114248   CHARACTER(LEN=lc) :: cn_coord1 = '' 
    115249   CHARACTER(LEN=lc) :: cn_bathy1 = '' 
    116250   INTEGER(i4)       :: in_perio1 = -1 
    117251   INTEGER(i4)       :: in_extrap = 0 
    118    LOGICAL           :: ln_fillclosed = .TRUE. 
    119  
    120    CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varinfo = '' 
    121    CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varfile = '' 
    122  
    123    INTEGER(i4)       :: in_imin0 = 0 
    124    INTEGER(i4)       :: in_imax0 = 0 
    125    INTEGER(i4)       :: in_jmin0 = 0 
    126    INTEGER(i4)       :: in_jmax0 = 0 
     252 
     253   !namzgr 
     254   REAL(dp)          :: dn_pp_to_be_computed = 0._dp 
     255   REAL(dp)          :: dn_ppsur     = -3958.951371276829_dp 
     256   REAL(dp)          :: dn_ppa0      =   103.9530096000000_dp 
     257   REAL(dp)          :: dn_ppa1      =     2.4159512690000_dp 
     258   REAL(dp)          :: dn_ppa2      =   100.7609285000000_dp 
     259   REAL(dp)          :: dn_ppkth     =    15.3510137000000_dp 
     260   REAL(dp)          :: dn_ppkth2    =    48.0298937200000_dp 
     261   REAL(dp)          :: dn_ppacr     =     7.0000000000000_dp 
     262   REAL(dp)          :: dn_ppacr2    =    13.000000000000_dp 
     263   REAL(dp)          :: dn_ppdzmin   = 6._dp 
     264   REAL(dp)          :: dn_pphmax    = 5750._dp 
     265   INTEGER(i4)       :: in_nlevel    = 75 
     266 
     267   !namzps 
     268   REAL(dp)          :: dn_e3zps_min = 25._dp 
     269   REAL(dp)          :: dn_e3zps_rat = 0.2_dp 
     270 
     271   ! namvar 
     272   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
     273   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
     274 
     275   ! namnst 
    127276   INTEGER(i4)       :: in_rhoi = 0 
    128277   INTEGER(i4)       :: in_rhoj = 0 
    129278 
    130    CHARACTER(LEN=lc) :: cn_fileout = 'restart'  
     279   ! namout 
     280   CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc'  
    131281   INTEGER(i4)       :: in_nproc   = 0 
    132282   INTEGER(i4)       :: in_niproc  = 0 
     
    138288   NAMELIST /namlog/ &  !< logger namelist 
    139289   &  cn_logfile,    &  !< log file 
    140    &  cn_verbosity      !< log verbosity 
     290   &  cn_verbosity,  &  !< log verbosity 
     291   &  in_maxerror       !< logger maximum error 
    141292 
    142293   NAMELIST /namcfg/ &  !< configuration namelist 
    143294   &  cn_varcfg         !< variable configuration file 
    144295 
    145    NAMELIST /namcrs/ &   !< coarse grid namelist 
    146    &  cn_coord0,  &      !< coordinate file 
    147    &  in_perio0          !< periodicity index 
     296   NAMELIST /namcrs/ &  !< coarse grid namelist 
     297   &  cn_coord0,  &     !< coordinate file 
     298   &  in_perio0         !< periodicity index 
    148299    
    149    NAMELIST /namfin/ &   !< fine grid namelist 
    150    &  cn_coord1,   &     !< coordinate file 
    151    &  cn_bathy1,   &     !< bathymetry file 
    152    &  in_perio1,   &     !< periodicity index 
    153    &  in_extrap,   &     !< 
    154    &  ln_fillclosed      !< fill closed sea 
     300   NAMELIST /namfin/ &  !< fine grid namelist 
     301   &  cn_coord1,   &    !< coordinate file 
     302   &  cn_bathy1,   &    !< bathymetry file 
     303   &  in_perio1,   &    !< periodicity index 
     304   &  in_extrap 
    155305  
     306   NAMELIST /namzgr/ & 
     307   &  dn_pp_to_be_computed, & 
     308   &  dn_ppsur,     & 
     309   &  dn_ppa0,      & 
     310   &  dn_ppa1,      & 
     311   &  dn_ppa2,      & 
     312   &  dn_ppkth,     & 
     313   &  dn_ppkth2,    & 
     314   &  dn_ppacr,     & 
     315   &  dn_ppacr2,    & 
     316   &  dn_ppdzmin,   & 
     317   &  dn_pphmax,    & 
     318   &  in_nlevel         !< number of vertical level 
     319 
     320   NAMELIST /namzps/ & 
     321   &  dn_e3zps_min, & 
     322   &  dn_e3zps_rat 
     323 
    156324   NAMELIST /namvar/ &  !< variable namelist 
    157    &  cn_varinfo, &     !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' ) 
     325   &  cn_varinfo, &     !< list of variable and interpolation method to be used. 
    158326   &  cn_varfile        !< list of variable file 
    159327    
    160328   NAMELIST /namnst/ &  !< nesting namelist 
    161    &  in_imin0,    &     !< i-direction lower left  point indice  
    162    &  in_imax0,    &     !< i-direction upper right point indice 
    163    &  in_jmin0,    &     !< j-direction lower left  point indice 
    164    &  in_jmax0,    &     !< j-direction upper right point indice 
    165329   &  in_rhoi,    &     !< refinement factor in i-direction 
    166330   &  in_rhoj           !< refinement factor in j-direction 
     
    174338   !------------------------------------------------------------------- 
    175339 
    176    !1- namelist 
    177    !1-1 get namelist 
     340   ! namelist 
     341   ! get namelist 
    178342   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec 
    179343   IF( il_narg/=1 )THEN 
     
    184348   ENDIF 
    185349    
    186    !1-2 read namelist 
     350   ! read namelist 
    187351   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 
    188352   IF( ll_exist )THEN 
     
    203367 
    204368      READ( il_fileid, NML = namlog ) 
    205       !1-2-1 define log file 
    206       CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity)) 
     369      ! define log file 
     370      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror) 
    207371      CALL logger_header() 
    208372 
    209373      READ( il_fileid, NML = namcfg ) 
    210       !1-2-2 get variable extra information 
     374      ! get variable extra information 
    211375      CALL var_def_extra(TRIM(cn_varcfg)) 
    212376 
    213377      READ( il_fileid, NML = namcrs ) 
    214378      READ( il_fileid, NML = namfin ) 
     379      READ( il_fileid, NML = namzgr ) 
    215380      READ( il_fileid, NML = namvar ) 
    216       !1-2-3 add user change in extra information 
     381      ! add user change in extra information 
    217382      CALL var_chg_extra(cn_varinfo) 
    218       !1-2-4 match variable with file 
     383      ! match variable with file 
    219384      tl_multi=multi_init(cn_varfile) 
    220385       
     
    231396 
    232397      PRINT *,"ERROR in create_restart: can't find "//TRIM(cl_namelist) 
    233  
    234    ENDIF 
    235  
    236    !2- open files 
     398      STOP 
     399 
     400   ENDIF 
     401 
     402   !  
     403   CALL multi_print(tl_multi) 
     404   IF( tl_multi%i_nvar <= 0 )THEN 
     405      CALL logger_fatal("CREATE RESTART: no variable to be used."//& 
     406      &  " check namelist.") 
     407   ENDIF 
     408 
     409   ! open files 
    237410   IF( cn_coord0 /= '' )THEN 
    238       tl_coord0=file_init(TRIM(cn_coord0),id_perio=in_perio0) 
    239       CALL iom_open(tl_coord0) 
     411      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0) 
     412      CALL grid_get_info(tl_coord0) 
    240413   ELSE 
    241414      CALL logger_fatal("CREATE RESTART: no coarse grid coordinate found. "//& 
     
    244417 
    245418   IF( TRIM(cn_coord1) /= '' )THEN 
    246       tl_coord1=file_init(TRIM(cn_coord1),id_perio=in_perio1) 
    247       CALL iom_open(tl_coord1) 
     419      tl_coord1=mpp_init( file_init(TRIM(cn_coord1)), id_perio=in_perio1) 
     420      CALL grid_get_info(tl_coord1) 
    248421   ELSE 
    249422      CALL logger_fatal("CREATE RESTART: no fine grid coordinate found. "//& 
     
    252425 
    253426   IF( TRIM(cn_bathy1) /= '' )THEN 
    254       tl_bathy1=file_init(TRIM(cn_bathy1),id_perio=in_perio1) 
    255       CALL iom_open(tl_bathy1) 
     427      tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1) 
     428      CALL grid_get_info(tl_bathy1) 
    256429   ELSE 
    257430      CALL logger_fatal("CREATE RESTART: no fine grid bathymetry found. "//& 
     
    259432   ENDIF 
    260433 
    261    !3- check 
    262    !3-2-1 check refinement factor 
     434   ! check 
     435   ! check output file do not already exist 
     436   cl_fileout=file_rename(cn_fileout,1) 
     437   INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist) 
     438   IF( ll_exist )THEN 
     439      CALL logger_fatal("CREATE RESTART: output file "//TRIM(cl_fileout)//& 
     440      &  " already exist.") 
     441   ENDIF 
     442 
     443   ! check refinement factor 
    263444   il_rho(:)=1 
    264445   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN 
     
    270451   ENDIF 
    271452 
    272    IF( cn_coord0 /= '' )THEN !.OR. cn_bathy0 /= '' )THEN 
    273  
    274       !3-1 check namelist 
    275       IF( in_imin0 < 1 .OR. in_imax0 < 1 .OR. in_jmin0 < 1 .OR. in_jmax0 < 1)THEN 
    276          ! compute coarse grid indices around fine grid 
    277          IF( cn_coord0 /= '' )THEN 
    278             il_ind(:,:,:)=grid_get_coarse_index(tl_coord0, tl_coord1 ) 
    279          ENDIF 
    280  
    281          il_imin0=il_ind(1,1,1) ; il_imax0=il_ind(1,2,1) 
    282          il_jmin0=il_ind(2,1,1) ; il_jmax0=il_ind(2,2,1) 
    283  
    284          il_offset(:,:)=il_ind(:,:,2) 
    285       ELSE 
    286          il_imin0=in_imin0 ; il_imax0=in_imax0 
    287          il_jmin0=in_jmin0 ; il_jmax0=in_jmax0 
    288  
    289          il_offset(1,:)=FLOOR(REAL(il_rho(jp_I)-1,dp)*0.5) 
    290          il_offset(2,:)=FLOOR(REAL(il_rho(jp_J)-1,dp)*0.5)          
    291       ENDIF 
    292  
    293       !3-2 check domain validity 
    294       IF( cn_coord0 /= '' )THEN 
    295          CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0) 
    296       ENDIF 
    297  
    298       !3-3 check coordinate file 
    299       IF( cn_coord0 /= '' )THEN 
    300          CALL grid_check_coincidence( tl_coord0, tl_coord1, & 
    301          &                            il_imin0, il_imax0, & 
    302          &                            il_jmin0, il_jmax0, & 
    303          &                            il_rho(:) ) 
    304       ENDIF 
    305  
    306    ENDIF 
     453   ! check domain indices 
     454   ! compute coarse grid indices around fine grid 
     455   il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, & 
     456   &                                 id_rho=il_rho(:)) 
     457 
     458   il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2) 
     459   il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2) 
     460 
     461   ! check domain validity 
     462   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0) 
     463 
     464   !3-2-4 check coincidence between coarse and fine grid 
     465   CALL grid_check_coincidence( tl_coord0, tl_coord1, & 
     466   &                            il_imin0, il_imax0, & 
     467   &                            il_jmin0, il_jmax0, & 
     468   &                            il_rho(:) ) 
    307469 
    308470   ! compute level 
    309    ALLOCATE(tl_level(ig_npoint)) 
     471   ALLOCATE(tl_level(ip_npoint)) 
    310472   tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 
    311473 
    312474   ! remove ghost cell 
    313    il_xghost(:)=grid_get_ghost(tl_bathy1) 
    314  
    315    DO ji=1,ig_npoint 
    316       CALL grid_del_ghost(tl_level(ji), il_xghost(1), il_xghost(2)) 
     475   il_xghost(:,:)=grid_get_ghost(tl_bathy1) 
     476   DO ji=1,ip_npoint 
     477      CALL grid_del_ghost(tl_level(ji), il_xghost(:,:)) 
    317478   ENDDO 
    318479 
    319    ! close 
    320    CALL iom_close(tl_bathy1) 
    321  
    322    !4- work on variables 
    323    IF( .NOT. ASSOCIATED(tl_multi%t_file) )THEN 
     480   ! clean 
     481   CALL mpp_clean(tl_bathy1) 
     482 
     483   ! work on variables 
     484   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN 
    324485      CALL logger_error("CREATE RESTART: no file to work on. "//& 
    325486      &                 "check cn_varfile in namelist.") 
    326487   ELSE 
    327488      ALLOCATE( tl_var( tl_multi%i_nvar ) ) 
     489 
    328490      jvar=0 
    329491      ! for each file 
    330       DO ji=1,tl_multi%i_nfile 
    331          WRITE(cl_data,'(a,i2.2)') 'data_',jvar+1 
    332  
    333          IF( .NOT. ASSOCIATED(tl_multi%t_file(ji)%t_var) )THEN 
     492      DO ji=1,tl_multi%i_nmpp 
     493         WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1 
     494 
     495         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN 
    334496 
    335497            CALL logger_error("CREATE RESTART: no variable to work on for "//& 
    336             &                 "file "//TRIM(tl_multi%t_file(ji)%c_name)//& 
     498            &                 "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//& 
    337499            &                 ". check cn_varfile in namelist.") 
    338500 
    339          ELSEIF( TRIM(tl_multi%t_file(ji)%c_name) == TRIM(cl_data) )THEN 
    340          !4-1 use input matrix to fill variable 
    341  
     501         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN 
     502         !- use input matrix to fill variable 
     503 
     504            WRITE(*,'(a)') "work on data" 
    342505            ! for each variable initialise from matrix 
    343             DO jj=1,tl_multi%t_file(ji)%i_nvar 
     506            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     507 
    344508               jvar=jvar+1 
    345                tl_tmp=tl_multi%t_file(ji)%t_var(jj) 
    346                !4-1-1 fill value with matrix data 
    347                ! pb voir comment gerer nb de dimension 
    348                tl_var(jvar)=create_restart_matrix(tl_tmp, tl_coord1) 
    349  
    350                !4-1-2 use mask 
    351                CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
     509                
     510               WRITE(*,'(2x,a,a)') "work on variable "//& 
     511               &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
     512 
     513               ! fill value with matrix data 
     514               tl_var(jvar) = create_restart_matrix( & 
     515               &  tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, & 
     516               &  in_nlevel, tl_level(:) ) 
     517 
    352518            ENDDO 
    353  
     519         !- end of use input matrix to fill variable 
    354520         ELSE 
    355          !4-2 use file to fill variable 
    356  
    357             ! open file 
    358             tl_file=file_init(TRIM(tl_multi%t_file(ji)%c_name)) 
    359             CALL iom_open(tl_file) 
     521         !- use mpp file to fill variable 
     522 
     523            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name) 
     524            ! 
     525            tl_mpp=mpp_init( file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name)) ) 
     526            CALL grid_get_info(tl_mpp) 
     527 
     528            ! check vertical dimension 
     529            IF( tl_mpp%t_dim(jp_K)%l_use .AND. & 
     530            &   tl_mpp%t_dim(jp_K)%i_len /= in_nlevel  )THEN 
     531               CALL logger_error("CREATE RESTART: dimension in file "//& 
     532               &  TRIM(tl_mpp%c_name)//" not agree with namelist in_nlevel ") 
     533            ENDIF 
     534 
     535            ! open mpp file 
     536            CALL iom_mpp_open(tl_mpp) 
    360537 
    361538            ! get or check depth value 
    362             IF( tl_file%i_depthid /= 0 )THEN 
    363                IF( ASSOCIATED(tl_depth%d_value) )THEN 
    364                   IF( ANY( tl_depth%d_value(:,:,:,:) /= & 
    365                   &        tl_tmp%d_value(:,:,:,:) ) )THEN 
    366                      CALL logger_fatal("CREATE RESTART: depth value from "//& 
    367                      &  TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& 
    368                      &  " to those from former file(s).") 
    369                   ENDIF 
    370                ELSE 
    371                   tl_depth=iom_read_var(tl_file,tl_file%i_depthid) 
     539            CALL create_restart_check_depth( tl_mpp, tl_depth ) 
     540 
     541            ! get or check time value 
     542            CALL create_restart_check_time( tl_mpp, tl_time ) 
     543 
     544            ! close mpp file 
     545            CALL iom_mpp_close(tl_mpp) 
     546 
     547            IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 
     548            &        tl_coord0%t_dim(1:2)%i_len) )THEN 
     549            !!! extract value from fine grid  
     550 
     551               IF( ANY( tl_mpp%t_dim(1:2)%i_len <= & 
     552               &        tl_coord1%t_dim(1:2)%i_len) )THEN 
     553                  CALL logger_fatal("CREATE RESTART: dimension in file "//& 
     554                  &  TRIM(tl_mpp%c_name)//" smaller than those in fine"//& 
     555                  &  " grid coordinates.") 
    372556               ENDIF 
    373             ENDIF 
    374  
    375             ! get or check time value 
    376             IF( tl_file%i_timeid /= 0 )THEN 
    377                IF( ASSOCIATED(tl_time%d_value) )THEN 
    378                   IF( ANY( tl_time%d_value(:,:,:,:) /= & 
    379                   &        tl_tmp%d_value(:,:,:,:) ) )THEN 
    380                      CALL logger_fatal("CREATE RESTART: time value from "//& 
    381                      &  TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& 
    382                      &  " to those from former file(s).") 
    383                   ENDIF 
    384                ELSE 
    385                   tl_time=iom_read_var(tl_file,tl_file%i_timeid) 
    386                ENDIF 
    387             ENDIF 
    388  
    389             IF( ANY( tl_file%t_dim(1:2)%i_len /= & 
    390             &      tl_coord0%t_dim(1:2)%i_len) )THEN 
    391             !4-2-1 extract value from fine grid  
    392  
    393                !4-2-1-1 compute domain on fine grid 
    394                tl_dom1=create__restart_get_dom_coord(tl_file, tl_coord1) 
     557 
     558               ! compute domain on fine grid 
     559               il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 ) 
     560 
     561               il_imin1=il_ind(1,1) ; il_imax1=il_ind(1,2) 
     562               il_jmin1=il_ind(2,1) ; il_jmax1=il_ind(2,2) 
     563 
     564               !- check grid coincidence 
     565               CALL grid_check_coincidence( tl_mpp, tl_coord1, & 
     566               &                            il_imin1, il_imax1, & 
     567               &                            il_jmin1, il_jmax1, & 
     568               &                            il_rho(:) ) 
     569 
     570               ! compute domain 
     571               tl_dom1=dom_init(tl_mpp,         & 
     572               &                il_imin1, il_imax1, & 
     573               &                il_jmin1, il_jmax1) 
    395574                
    396                ! open mpp file on domain 
    397                !4-2-1-2 init mpp structure 
    398                tl_mpp=mpp_init(tl_file) 
    399  
    400                !4-2-1-3 get processor to be used 
    401                CALL mpp_get_use( tl_mpp, tl_dom1 ) 
    402                !4-2-1-4 open mpp files 
    403                CALL iom_mpp_open(tl_mpp) 
     575               ! open mpp files 
     576               CALL iom_dom_open(tl_mpp, tl_dom1) 
    404577 
    405578               ! for each variable of this file 
    406                DO jj=1,tl_multi%t_file(ji)%i_nvar 
     579               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     580 
     581                  WRITE(*,'(2x,a,a)') "work on variable "//& 
     582                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
     583 
    407584                  jvar=jvar+1 
    408                   cl_name=tl_multi%t_file(ji)%t_var(jj)%c_name 
    409                   !4-2-1-5 read variable over domain 
    410                   tl_var(jvar)=iom_mpp_read_var( tl_mpp, TRIM(cl_name), & 
    411                   &                              td_dom=tl_dom1 ) 
    412  
    413                   !4-2-1-7 add attribute to variable 
     585                  cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name 
     586                  ! read variable over domain 
     587                  tl_var(jvar)=iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom1) 
     588 
     589                  ! add attribute to variable 
    414590                  tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 
    415591                  CALL var_move_att(tl_var(jvar), tl_att) 
    416592 
     593                  tl_att=att_init('src_i_indices',(/il_imin0, il_imax0/)) 
     594                  CALL var_move_att(tl_var(jvar), tl_att) 
     595 
     596                  tl_att=att_init('src_j_indices',(/il_jmin0, il_jmax0/)) 
     597                  CALL var_move_att(tl_var(jvar), tl_att) 
     598 
    417599                  ! clean structure 
    418600                  CALL att_clean(tl_att) 
    419601 
    420                   !4-2-1-8 use mask 
     602                  ! use mask 
    421603                  CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
    422604 
    423                   !4-2-1-9 add ghost cell 
    424                   CALL grid_add_ghost( tl_var(jvar), & 
    425                   &                    tl_dom1%i_ighost,tl_dom1%i_jghost ) 
     605                  ! add ghost cell 
     606                  CALL grid_add_ghost( tl_var(jvar), tl_dom1%i_ghost(:,:) ) 
    426607 
    427608               ENDDO 
    428609 
    429                !4-2-1-2 close mpp file 
    430                CALL iom_mpp_close(tl_mpp) 
     610               ! close mpp file 
     611               CALL iom_dom_close(tl_mpp) 
     612 
    431613               ! clean structure 
    432614               CALL mpp_clean(tl_mpp) 
     
    434616 
    435617            ELSE 
    436             !4-2-2 get value from coarse grid  
    437  
    438                !4-2-2-1 compute domain on coarse grid 
    439                tl_dom0=create__restart_get_dom_index(tl_file, il_imin0, il_jmin0, & 
    440                &                                              il_imax0, il_jmax0) 
    441  
    442                !4-2-2-2 add extra band (if possible) to compute interpolation 
     618            !!! get value from coarse grid  
     619 
     620               ! compute domain on coarse grid 
     621               tl_dom0=dom_init(tl_mpp,             & 
     622               &                il_imin0, il_imax0, & 
     623               &                il_jmin0, il_jmax0 ) 
     624 
     625               ! add extra band (if possible) to compute interpolation 
    443626               CALL dom_add_extra(tl_dom0) 
    444627 
    445                ! open mpp file on domain 
    446                !4-2-2-3 init mpp structure 
    447                tl_mpp=mpp_init(tl_file) 
    448  
    449                !4-2-2-4 get processor to be used 
    450                CALL mpp_get_use( tl_mpp, tl_dom0 ) 
    451  
    452                !4-2-2-5 open mpp files 
    453                CALL iom_mpp_open(tl_mpp) 
    454  
     628               ! open mpp files 
     629               CALL iom_dom_open(tl_mpp, tl_dom0) 
    455630               ! for each variable of this file 
    456                DO jj=1,tl_multi%t_file(ji)%i_nvar 
     631               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     632 
     633                  WRITE(*,'(2x,a,a)') "work on variable "//& 
     634                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    457635 
    458636                  jvar=jvar+1 
    459                   cl_name=tl_multi%t_file(ji)%t_var(jj)%c_name 
    460                   print *,'work on ',trim(cl_name) 
    461                   !4-2-2-6 read variable over domain 
    462                   tl_var(jvar)=iom_mpp_read_var( tl_mpp, TRIM(cl_name), & 
    463                   &                              td_dom=tl_dom0 ) 
    464  
    465                   !4-2-2-7 interpolate variable 
     637                  cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name 
     638 
     639                  ! read variable over domain 
     640                  tl_var(jvar)=iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0) 
     641 
     642                  il_offset(:,:)=grid_get_fine_offset(tl_coord0, & 
     643                  &                                   il_imin0, il_jmin0, & 
     644                  &                                   il_imax0, il_jmax0, & 
     645                  &                                   tl_coord1, & 
     646                  &                                   id_rho=il_rho(:), & 
     647                  &                                   cd_point=TRIM(tl_var(jvar)%c_point)) 
     648                   
     649 
     650                  ! interpolate variable 
    466651                  CALL create_restart_interp(tl_var(jvar), tl_level(:), & 
    467652                  &                          il_rho(:), & 
    468653                  &                          id_offset=il_offset(:,:)) 
    469654 
    470                   !tl_att=att_init('add_offset',0.) 
    471                   !CALL var_move_att(tl_var(jvar), tl_att) 
    472                   !tl_att=att_init('scale_factor',1.) 
    473                   !CALL var_move_att(tl_var(jvar), tl_att) 
    474  
    475                   !4-2-2-8 remove extraband added to domain 
     655                  ! remove extraband added to domain 
    476656                  CALL dom_del_extra( tl_var(jvar), tl_dom0, il_rho(:) ) 
    477657 
    478                   !4-2-2-10 add attribute to variable 
     658                  ! add attribute to variable 
    479659                  tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 
    480660                  CALL var_move_att(tl_var(jvar), tl_att) 
    481661 
     662                  tl_att=att_init('src_i-indices',(/il_imin0, il_imax0/)) 
     663                  CALL var_move_att(tl_var(jvar), tl_att) 
     664 
     665                  tl_att=att_init('src_j-indices',(/il_jmin0, il_jmax0/)) 
     666                  CALL var_move_att(tl_var(jvar), tl_att) 
     667 
     668                  IF( ANY(il_rho(:)/=1) )THEN 
     669                     tl_att=att_init("refinment_factor", & 
     670                     &               (/il_rho(jp_I),il_rho(jp_J)/)) 
     671                     CALL var_move_att(tl_var(jvar), tl_att) 
     672                  ENDIF 
     673 
    482674                  ! clean structure 
    483675                  CALL att_clean(tl_att) 
    484676 
    485                   !4-2-2-11 use mask 
     677                  ! use mask 
    486678                  CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
    487679 
    488                   !4-2-2-12 add ghost cell 
    489                   CALL grid_add_ghost( tl_var(jvar), & 
    490                   &                    tl_dom0%i_ighost,tl_dom0%i_jghost ) 
     680                  ! add ghost cell 
     681                  CALL grid_add_ghost( tl_var(jvar), il_xghost(:,:) ) 
     682 
    491683 
    492684               ENDDO 
    493685 
    494                !4-2-2-2 close mpp file 
    495                CALL iom_mpp_close(tl_mpp) 
     686               ! close mpp file 
     687               CALL iom_dom_close(tl_mpp) 
     688 
    496689               ! clean structure 
    497690               CALL mpp_clean(tl_mpp) 
     
    500693            ENDIF 
    501694 
    502             ! close file 
    503             CALL iom_close(tl_file) 
    504695            ! clean structure 
    505             CALL file_clean(tl_file) 
     696            CALL mpp_clean(tl_mpp) 
    506697         ENDIF 
    507698      ENDDO 
    508699   ENDIF 
    509700 
    510    !5- use additional request 
    511    DO jvar=1,tl_multi%i_nvar 
    512  
    513          !5-1 forced min and max value 
    514          CALL var_limit_value(tl_var(jvar)) 
    515  
    516          !5-2 filter 
    517          CALL filter_fill_value(tl_var(jvar)) 
    518  
    519          !5-3 extrapolate 
    520          CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, & 
    521          &                                    id_jext=in_extrap, & 
    522          &                                    id_kext=in_extrap) 
     701   il_nvar=tl_multi%i_nvar 
     702 
     703   ! clean 
     704   CALL multi_clean(tl_multi) 
     705   CALL mpp_clean(tl_coord0) 
     706 
     707   ! use additional request 
     708   DO jvar=1,il_nvar 
     709 
     710      ! forced min and max value 
     711      CALL var_limit_value(tl_var(jvar)) 
     712 
     713      ! filter 
     714      CALL filter_fill_value(tl_var(jvar)) 
     715 
     716      ! extrapolate 
     717      CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, & 
     718      &                                    id_jext=in_extrap, & 
     719      &                                    id_kext=in_extrap) 
    523720 
    524721   ENDDO 
    525722 
    526    !6- create file 
     723   ! create file 
    527724   IF( in_niproc == 0 .AND. & 
    528725   &   in_njproc == 0 .AND. & 
     
    532729      in_nproc = 1 
    533730   ENDIF 
    534    tl_mppout=mpp_init( TRIM(cn_fileout), tl_var(1), & 
    535    &                   in_niproc, in_njproc, in_nproc, & 
    536    &                   cd_type=cn_type) 
    537  
    538    !6-1 add dimension 
     731 
     732   ! add dimension 
    539733   tl_dim(:)=var_max_dim(tl_var(:)) 
     734 
     735   DO ji=1,il_nvar 
     736 
     737      IF( ALL(tl_var(ji)%t_dim(:)%i_len == tl_dim(:)%i_len) )THEN 
     738         tl_mppout=mpp_init( TRIM(cn_fileout), tl_var(ji), & 
     739         &                   in_niproc, in_njproc, in_nproc, & 
     740         &                   cd_type=cn_type) 
     741         EXIT 
     742      ENDIF 
     743 
     744   ENDDO 
    540745 
    541746   DO ji=1,ip_maxdim 
     
    551756   ENDDO 
    552757 
    553    !6-2 add variables 
    554  
    555    !IF( ALL( tl_dim(1:2)%l_use ) )THEN 
    556    !   ! add longitude 
    557    !   tl_lon=iom_read_var(tl_coord1,'longitude') 
    558  
    559    !   CALL mpp_add_var(tl_mppout, tl_lon) 
    560    !   CALL var_clean(tl_lon) 
    561  
    562    !   ! add latitude 
    563    !   tl_lat=iom_read_var(tl_coord1,'latitude') 
    564  
    565    !   CALL mpp_add_var(tl_mppout, tl_lat) 
    566    !   CALL var_clean(tl_lat) 
    567    !ENDIF 
    568  
    569    !IF( tl_dim(3)%l_use )THEN 
    570    !   ! add depth 
    571    !   CALL mpp_add_var(tl_mppout, tl_depth) 
    572    !   CALL var_clean(tl_depth) 
    573    !ENDIF 
    574  
    575    !IF( tl_dim(4)%l_use )THEN 
    576    !   ! add time 
    577    !   CALL mpp_add_var(tl_mppout, tl_time) 
    578    !   CALL var_clean(tl_time) 
    579    !ENDIF 
     758   ! add variables 
     759   IF( ALL( tl_dim(1:2)%l_use ) )THEN 
     760 
     761      ! open mpp files 
     762      CALL iom_mpp_open(tl_coord1) 
     763 
     764      ! add longitude 
     765      tl_lon=iom_mpp_read_var(tl_coord1,'longitude') 
     766      CALL mpp_add_var(tl_mppout, tl_lon) 
     767      CALL var_clean(tl_lon) 
     768 
     769      ! add latitude 
     770      tl_lat=iom_mpp_read_var(tl_coord1,'latitude') 
     771      CALL mpp_add_var(tl_mppout, tl_lat) 
     772      CALL var_clean(tl_lat) 
     773 
     774      ! close mpp files 
     775      CALL iom_mpp_close(tl_coord1) 
     776 
     777   ENDIF 
     778 
     779   IF( tl_dim(3)%l_use )THEN 
     780      IF( ASSOCIATED(tl_depth%d_value) )THEN 
     781         ! add depth 
     782         CALL mpp_add_var(tl_mppout, tl_depth) 
     783      ELSE 
     784         CALL logger_error("CREATE RESTART: no value for depth variable.") 
     785      ENDIF 
     786   ENDIF 
     787   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth) 
     788 
     789   IF( tl_dim(4)%l_use )THEN 
     790      IF( ASSOCIATED(tl_time%d_value) )THEN 
     791         ! add time 
     792         CALL mpp_add_var(tl_mppout, tl_time) 
     793      ELSE 
     794         CALL logger_error("CREATE RESTART: no value for time variable.") 
     795      ENDIF 
     796   ENDIF 
     797   IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time) 
    580798 
    581799   ! add other variable 
    582    DO jvar=1,tl_multi%i_nvar 
    583       CALL mpp_add_var(tl_mppout, tl_var(jvar)) 
    584       CALL var_clean(tl_var(jvar)) 
     800   DO jvar=1,il_nvar 
     801      ! check if variable already add 
     802      il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name) 
     803      IF( il_index == 0 )THEN 
     804         CALL mpp_add_var(tl_mppout, tl_var(jvar)) 
     805         CALL var_clean(tl_var(jvar)) 
     806      ENDIF 
    585807   ENDDO 
    586808 
    587    DO ji=1,4 
    588       CALL mpp_add_var(tl_mppout,tl_level(ji)) 
    589    ENDDO 
    590  
    591    !6-3 add some attribute 
     809!   DO ji=1,4 
     810!      CALL grid_add_ghost( tl_level(ji), il_xghost(:,:) ) 
     811!      CALL var_clean(tl_level(ji)) 
     812!   ENDDO 
     813 
     814   ! add some attribute 
    592815   tl_att=att_init("Created_by","SIREN create_restart") 
    593816   CALL mpp_add_att(tl_mppout, tl_att) 
     
    616839   ENDIF 
    617840 
    618    !6-4 create file 
     841   ! create file 
    619842   CALL iom_mpp_create(tl_mppout) 
    620843 
    621    !6-5 write file 
     844   ! write file 
    622845   CALL iom_mpp_write_file(tl_mppout) 
    623  
    624    !6-6 close file 
     846   ! close file 
    625847   CALL iom_mpp_close(tl_mppout) 
    626    IF( cn_coord0 /= '' ) CALL iom_close(tl_coord0) 
    627  
    628    !7- clean 
     848 
     849   ! print 
     850   CALL mpp_print(tl_mppout) 
     851 
     852   ! clean 
     853   CALL att_clean(tl_att) 
     854   CALL var_clean(tl_var(:)) 
    629855   DEALLOCATE(tl_var) 
     856   CALL var_clean(tl_level(:)) 
     857   DEALLOCATE(tl_level) 
    630858 
    631859   CALL mpp_clean(tl_mppout) 
    632    CALL file_clean(tl_coord1) 
    633    CALL file_clean(tl_coord0) 
     860   CALL mpp_clean(tl_coord1) 
    634861 
    635862   ! close log file 
     
    637864   CALL logger_close() 
    638865 
    639 !> @endcode 
    640866CONTAINS 
    641    !------------------------------------------------------------------- 
    642    !> @brief 
    643    !>  
    644    !> @details  
    645    !> 
    646    !> @author J.Paul 
    647    !> - Nov, 2013- Initial Version 
    648    !> 
    649    !------------------------------------------------------------------- 
    650    !> @code 
    651    FUNCTION create_restart_level(td_level1) 
    652       IMPLICIT NONE 
    653       ! Argument 
    654       TYPE(TFILE), INTENT(IN) :: td_level1 
    655  
    656       ! function 
    657       TYPE(TVAR), DIMENSION(4) :: create_restart_level 
    658  
    659       ! local variable 
    660       TYPE(TFILE)              :: tl_level1 
    661       TYPE(TVAR), DIMENSION(4) :: tl_var 
    662       TYPE(TMPP)               :: tl_mpplevel1 
    663  
    664       ! loop indices 
    665       !---------------------------------------------------------------- 
    666  
    667       !0- compute domain 
    668       tl_dom1=dom_init(td_level1) 
    669  
    670       !1 init mpp structure 
    671       tl_level1=td_level1 
    672       tl_mpplevel1=mpp_init(tl_level1) 
    673        
    674       CALL file_clean(tl_level1) 
    675  
    676       !2 get processor to be used 
    677       CALL mpp_get_use( tl_mpplevel1, tl_dom1 ) 
    678  
    679       !3 open mpp files 
    680       CALL iom_mpp_open(tl_mpplevel1) 
    681       tl_var(jp_T)=iom_mpp_read_var(tl_mpplevel1,'tlevel',td_dom=tl_dom1) 
    682       tl_var(jp_U)=iom_mpp_read_var(tl_mpplevel1,'ulevel',td_dom=tl_dom1) 
    683       tl_var(jp_V)=iom_mpp_read_var(tl_mpplevel1,'vlevel',td_dom=tl_dom1) 
    684       tl_var(jp_F)=iom_mpp_read_var(tl_mpplevel1,'flevel',td_dom=tl_dom1) 
    685  
    686       !4 save result 
    687       create_restart_level(:)=tl_var(:) 
    688  
    689       !5 clean 
    690       CALL iom_mpp_close(tl_mpplevel1) 
    691       CALL mpp_clean(tl_mpplevel1) 
    692  
    693    END FUNCTION create_restart_level 
    694    !> @endcode 
    695867   !------------------------------------------------------------------- 
    696868   !> @brief 
     
    699871   !> @details  
    700872   !> A variable is create with the same name that the input variable,  
    701    !> and with dimension of the coordinate file.  
    702    !> Then the variable table of value is split into equal subdomain. 
    703    !> Each subdomain is fill with the linked value of the matrix. 
     873   !> and with dimension of the coordinate file.<br/>  
     874   !> Then the variable array of value is split into equal subdomain. 
     875   !> Each subdomain is filled with the corresponding value of the matrix. 
    704876   !> 
    705877   !> @author J.Paul 
    706    !> - Nov, 2013- Initial Version 
     878   !> - November, 2013- Initial Version 
    707879   !> 
    708    !> @param[in] td_var : variable structure  
    709    !> @param[in] td_coord : coordinate  
     880   !> @param[in] td_var    variable structure  
     881   !> @param[in] td_coord  coordinate file structure  
     882   !> @param[in] id_nlevel number of vertical level   
     883   !> @param[in] td_level  array of level on T,U,V,F point (variable structure)  
    710884   !> @return variable structure  
    711885   !------------------------------------------------------------------- 
    712    !> @code 
    713    FUNCTION create_restart_matrix(td_var, td_coord) 
     886   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, td_level) 
    714887      IMPLICIT NONE 
    715888      ! Argument 
    716       TYPE(TVAR) , INTENT(IN) :: td_var 
    717       TYPE(TFILE), INTENT(IN) :: td_coord 
     889      TYPE(TVAR)              , INTENT(IN) :: td_var 
     890      TYPE(TMPP)              , INTENT(IN) :: td_coord 
     891      INTEGER(i4)             , INTENT(IN) :: id_nlevel 
     892      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level 
    718893 
    719894      ! function 
     
    721896 
    722897      ! local variable 
    723       INTEGER(i4)                                        :: il_ighost 
    724       INTEGER(i4)                                        :: il_jghost 
    725       INTEGER(i4)      , DIMENSION(2)                    :: il_xghost 
    726898      INTEGER(i4)      , DIMENSION(3)                    :: il_dim 
    727899      INTEGER(i4)      , DIMENSION(3)                    :: il_size 
    728900      INTEGER(i4)      , DIMENSION(3)                    :: il_rest 
     901      INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost 
    729902 
    730903      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape 
     
    734907      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 
    735908 
    736       TYPE(TVAR)                                         :: tl_lon 
    737       TYPE(TVAR)                                         :: tl_lat 
    738       TYPE(TVAR)                                         :: tl_var 
    739909      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim 
    740910 
     
    745915      !---------------------------------------------------------------- 
    746916 
    747       !1- read output grid 
    748       tl_lon=iom_read_var(td_coord,'longitude') 
    749       tl_lat=iom_read_var(td_coord,'latitude') 
    750  
    751       !2- look for ghost cell 
    752       il_xghost(:)=grid_get_ghost( tl_lon, tl_lat ) 
    753  
    754       il_ighost=il_xghost(1)*ig_ghost 
    755       il_jghost=il_xghost(2)*ig_ghost 
    756        
    757       !3- write value on grid 
    758       !3-1 get matrix dimension 
     917      ! look for ghost cell 
     918      il_xghost(:,:)=grid_get_ghost( td_coord ) 
     919 
     920      ! write value on grid 
     921      ! get matrix dimension 
    759922      il_dim(:)=td_var%t_dim(1:3)%i_len 
    760       !3-2 output dimension 
    761       tl_dim(:)=tl_lon%t_dim(:) 
     923 
     924      ! output dimension 
     925      tl_dim(jp_I:jp_J)=dim_copy(td_coord%t_dim(jp_I:jp_J)) 
     926      IF( id_nlevel >= 1 )THEN 
     927         tl_dim(jp_K)=dim_init('Z',id_nlevel) 
     928      ENDIF 
    762929 
    763930      ! remove ghost cell 
    764       tl_dim(1)%i_len=tl_dim(1)%i_len - 2*il_xghost(1)*ig_ghost 
    765       tl_dim(2)%i_len=tl_dim(2)%i_len - 2*il_xghost(2)*ig_ghost 
    766  
    767       !3-3 split output domain in N subdomain depending of matrix dimension  
     931      tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(il_xghost(jp_I,:))*ip_ghost 
     932      tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(il_xghost(jp_J,:))*ip_ghost 
     933 
     934      ! split output domain in N subdomain depending of matrix dimension  
    768935      il_size(:) = tl_dim(1:3)%i_len / il_dim(:) 
    769936      il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:)) 
     
    776943      ! add rest to last cell 
    777944      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1) 
    778        
    779945 
    780946      ALLOCATE( il_jshape(il_dim(2)+1) ) 
     
    794960      il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3) 
    795961 
    796       !3-3 write ouput table of value  
     962      ! write ouput array of value  
    797963      ALLOCATE(dl_value( tl_dim(1)%i_len, & 
    798964      &                  tl_dim(2)%i_len, & 
     
    815981      ENDDO 
    816982 
    817       !3-4 initialise variable with value 
    818       tl_var=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:)) 
     983      ! keep attribute and type 
     984      create_restart_matrix=var_copy(td_var) 
     985      DEALLOCATE( create_restart_matrix%d_value ) 
     986      ! save new dimension 
     987      create_restart_matrix%t_dim(:)=dim_copy(tl_dim(:)) 
     988      ! add variable value 
     989      CALL var_add_value( create_restart_matrix, dl_value(:,:,:,:), & 
     990      &                   id_type=td_var%i_type) 
    819991 
    820992      DEALLOCATE(dl_value) 
    821993 
    822       !4- add ghost cell 
    823       CALL grid_add_ghost(tl_var,il_ighost,il_jghost) 
    824  
    825       !5- save result 
    826       create_restart_matrix=tl_var 
     994      ! use mask 
     995      CALL create_restart_mask(create_restart_matrix, td_level(:)) 
     996 
     997      ! add ghost cell 
     998      CALL grid_add_ghost( create_restart_matrix, il_xghost(:,:) ) 
     999 
     1000      ! clean  
     1001      DEALLOCATE(il_ishape) 
     1002      DEALLOCATE(il_jshape) 
     1003      DEALLOCATE(il_kshape) 
    8271004 
    8281005   END FUNCTION create_restart_matrix 
    829    !> @endcode 
    8301006   !------------------------------------------------------------------- 
    8311007   !> @brief 
     1008   !> This subroutine use mask to filled land point with _FillValue 
    8321009   !>  
    833    !> @details  
     1010   !> @author J.Paul 
     1011   !> - November, 2013- Initial Version 
    8341012   !> 
    835    !> @author J.Paul 
    836    !> - Nov, 2013- Initial Version 
    837    !> 
     1013   !> @param[inout] td_var variable structure 
     1014   !> @param[in] td_mask   mask variable structure 
    8381015   !------------------------------------------------------------------- 
    839    !> @code 
    840    FUNCTION create__restart_get_dom_coord( td_file, td_coord, & 
    841    &                                       id_rho ) 
    842       IMPLICIT NONE 
    843       ! Argument 
    844       TYPE(TFILE),               INTENT(IN) :: td_file 
    845       TYPE(TFILE),               INTENT(IN) :: td_coord 
    846       INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 
    847  
    848       ! function 
    849       TYPE(TDOM) :: create__restart_get_dom_coord 
    850  
    851       ! local variable 
    852       INTEGER(i4)                 :: il_pivot 
    853       INTEGER(i4)                 :: il_perio 
    854  
    855       INTEGER(i4)                 :: il_imin 
    856       INTEGER(i4)                 :: il_imax 
    857       INTEGER(i4)                 :: il_jmin 
    858       INTEGER(i4)                 :: il_jmax 
    859  
    860       INTEGER(i4), DIMENSION(2,2,2) :: il_ind 
    861  
    862       TYPE(TFILE)                 :: tl_file 
    863  
    864       TYPE(TDOM)                  :: tl_dom 
    865       ! loop indices 
    866       !---------------------------------------------------------------- 
    867  
    868       tl_file=td_file 
    869       !1- open file 
    870       CALL iom_open(tl_file) 
    871  
    872       ! get periodicity 
    873       il_pivot=grid_get_pivot(tl_file) 
    874       il_perio=grid_get_perio(tl_file,il_pivot) 
    875  
    876       tl_file%i_perio=il_perio 
    877  
    878       !2- compute file grid indices around coord grid 
    879       il_ind(:,:,:)=grid_get_coarse_index(tl_file, td_coord ) 
    880  
    881       il_imin=il_ind(1,1,1) ; il_imax=il_ind(1,2,1) 
    882       il_jmin=il_ind(2,1,1) ; il_jmax=il_ind(2,2,1) 
    883  
    884       !3- check grid coincidence 
    885       CALL grid_check_coincidence( tl_file, td_coord, & 
    886       &                            il_imin, il_imax, & 
    887       &                            il_jmin, il_jmax, & 
    888       &                            id_rho(:) ) 
    889  
    890       !4- compute domain 
    891       tl_dom=dom_init(tl_file,         & 
    892       &               il_imin, il_imax, & 
    893       &               il_jmin, il_jmax) 
    894  
    895       ! close file 
    896       CALL iom_close(tl_file) 
    897  
    898       ! save result 
    899       create__restart_get_dom_coord=tl_dom 
    900  
    901    END FUNCTION create__restart_get_dom_coord 
    902    !> @endcode 
    903    !------------------------------------------------------------------- 
    904    !> @brief 
    905    !>  
    906    !> @details  
    907    !> 
    908    !> @author J.Paul 
    909    !> - Nov, 2013- Initial Version 
    910    !> 
    911    !------------------------------------------------------------------- 
    912    !> @code 
    913    FUNCTION create__restart_get_dom_index( td_file, id_imin, id_jmin, & 
    914    &                                                id_imax, id_jmax ) 
    915       IMPLICIT NONE 
    916       ! Argument 
    917       TYPE(TFILE), INTENT(IN) :: td_file 
    918       INTEGER(i4), INTENT(IN) :: id_imin 
    919       INTEGER(i4), INTENT(IN) :: id_imax 
    920       INTEGER(i4), INTENT(IN) :: id_jmin 
    921       INTEGER(i4), INTENT(IN) :: id_jmax 
    922  
    923       ! function 
    924       TYPE(TDOM) :: create__restart_get_dom_index 
    925  
    926       ! local variable 
    927       INTEGER(i4)                 :: il_pivot 
    928       INTEGER(i4)                 :: il_perio 
    929  
    930       TYPE(TFILE)                 :: tl_file 
    931  
    932       TYPE(TDOM)                  :: tl_dom 
    933       ! loop indices 
    934       !---------------------------------------------------------------- 
    935  
    936       ! init 
    937       tl_file=td_file 
    938       !1- open file 
    939       CALL iom_open(tl_file) 
    940  
    941       ! get periodicity 
    942       il_pivot=grid_get_pivot(tl_file) 
    943       il_perio=grid_get_perio(tl_file,il_pivot) 
    944  
    945       tl_file%i_perio=il_perio 
    946  
    947       !2- compute domain 
    948       tl_dom=dom_init(tl_file,         & 
    949       &               id_imin, id_imax, & 
    950       &               id_jmin, id_jmax) 
    951  
    952       ! close file 
    953       CALL iom_close(tl_file) 
    954  
    955       ! save result 
    956       create__restart_get_dom_index=tl_dom 
    957  
    958    END FUNCTION create__restart_get_dom_index 
    959    !> @endcode 
    960    !------------------------------------------------------------------- 
    961    !> @brief 
    962    !> This subroutine 
    963    !>  
    964    !> @details  
    965    !> 
    966    !> @author J.Paul 
    967    !> - Nov, 2013- Initial Version 
    968    !> 
    969    !> @param[in]  
    970    !> @todo  
    971    !------------------------------------------------------------------- 
    972    !> @code 
    9731016   SUBROUTINE create_restart_mask( td_var, td_mask ) 
    9741017 
     
    9871030      !---------------------------------------------------------------- 
    9881031 
    989       IF( ANY(td_var%t_dim(1:2)%i_len /= td_mask(1)%t_dim(1:2)%i_len) )THEN 
    990          CALL logger_error("CREATE RESTART MASK: dimension differ between "//& 
    991          &                 "variable ("//& 
    992          &                 TRIM(fct_str(td_var%t_dim(1)%i_len))//","//& 
    993          &                 TRIM(fct_str(td_var%t_dim(2)%i_len))//& 
    994          &                 ") and level ("//& 
    995          &                 TRIM(fct_str(td_mask(1)%t_dim(1)%i_len))//","//& 
    996          &                 TRIM(fct_str(td_mask(1)%t_dim(2)%i_len))//")") 
    997       ELSE 
    998          ALLOCATE( il_mask(td_var%t_dim(1)%i_len, & 
    999          &                 td_var%t_dim(2)%i_len) ) 
    1000  
    1001          SELECT CASE(TRIM(td_var%c_point)) 
    1002          CASE('T') 
    1003             il_mask(:,:)=INT(td_mask(jp_T)%d_value(:,:,1,1)) 
    1004          CASE('U') 
    1005             il_mask(:,:)=INT(td_mask(jp_U)%d_value(:,:,1,1)) 
    1006          CASE('V') 
    1007             il_mask(:,:)=INT(td_mask(jp_V)%d_value(:,:,1,1)) 
    1008          CASE('F') 
    1009             il_mask(:,:)=INT(td_mask(jp_F)%d_value(:,:,1,1)) 
    1010          END SELECT 
    1011  
    1012          DO jl=1,td_var%t_dim(4)%i_len 
    1013             DO jk=1,td_var%t_dim(3)%i_len 
    1014                WHERE( il_mask(:,:) < jk ) td_var%d_value(:,:,jk,jl)=99 !td_var%d_fill 
    1015                   !.AND. & 
    1016                   !&   td_var%d_value(:,:,jk,jl) == td_var%d_fill .OR. & 
    1017                   !&   il_mask(:,:) < jk .AND. & 
    1018                   !&   td_var%d_value(:,:,jk,jl) == 1 ) td_var%d_value(:,:,jk,jl)=99 !td_var%d_fill 
     1032      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
     1033         IF( ANY(td_var%t_dim(1:2)%i_len /= td_mask(1)%t_dim(1:2)%i_len) )THEN 
     1034            CALL logger_error("CREATE RESTART MASK: dimension differ between"//& 
     1035            &                 " variable "//TRIM(td_var%c_name)//" ("//& 
     1036            &                 TRIM(fct_str(td_var%t_dim(1)%i_len))//","//& 
     1037            &                 TRIM(fct_str(td_var%t_dim(2)%i_len))//& 
     1038            &                 ") and level ("//& 
     1039            &                 TRIM(fct_str(td_mask(1)%t_dim(1)%i_len))//","//& 
     1040            &                 TRIM(fct_str(td_mask(1)%t_dim(2)%i_len))//")") 
     1041         ELSE 
     1042            ALLOCATE( il_mask(td_var%t_dim(1)%i_len, & 
     1043            &                 td_var%t_dim(2)%i_len) ) 
     1044 
     1045            SELECT CASE(TRIM(td_var%c_point)) 
     1046            CASE('T') 
     1047               il_mask(:,:)=INT(td_mask(jp_T)%d_value(:,:,1,1)) 
     1048            CASE('U') 
     1049               il_mask(:,:)=INT(td_mask(jp_U)%d_value(:,:,1,1)) 
     1050            CASE('V') 
     1051               il_mask(:,:)=INT(td_mask(jp_V)%d_value(:,:,1,1)) 
     1052            CASE('F') 
     1053               il_mask(:,:)=INT(td_mask(jp_F)%d_value(:,:,1,1)) 
     1054            END SELECT 
     1055 
     1056            DO jl=1,td_var%t_dim(4)%i_len 
     1057               DO jk=1,td_var%t_dim(3)%i_len 
     1058                  WHERE( il_mask(:,:) < jk ) 
     1059                     td_var%d_value(:,:,jk,jl)=td_var%d_fill 
     1060                  END WHERE 
     1061               ENDDO 
    10191062            ENDDO 
    1020          ENDDO 
    1021  
    1022          DEALLOCATE( il_mask ) 
     1063 
     1064            DEALLOCATE( il_mask ) 
     1065         ENDIF 
    10231066      ENDIF 
    10241067   END SUBROUTINE create_restart_mask 
    1025    !> @endcode 
    10261068   !------------------------------------------------------------------- 
    10271069   !> @brief 
    1028    !> This subroutine 
     1070   !> This subroutine interpolate variable 
    10291071   !>  
    1030    !> @details  
    1031    !> 
    10321072   !> @author J.Paul 
    10331073   !> - Nov, 2013- Initial Version 
    10341074   !> 
    1035    !> @param[in]  
     1075   !> @param[inout] td_var    variable structure  
     1076   !> @param[inout] td_level  fine grid level, array of variable structure 
     1077   !> @param[in] id_rho       array of refinment factor 
     1078   !> @param[in] id_offset    array of offset between fine and coarse grid 
     1079   !> @param[in] id_iext      i-direction size of extra bands (default=im_minext) 
     1080   !> @param[in] id_jext      j-direction size of extra bands (default=im_minext) 
    10361081   !------------------------------------------------------------------- 
    1037    !> @code 
    1038    FUNCTION create_restart_extract(td_var, td_file, & 
    1039    &                             td_coord) 
    1040       IMPLICIT NONE 
    1041       ! Argument 
    1042       TYPE(TVAR) , INTENT(IN) :: td_var   
    1043       TYPE(TFILE), INTENT(IN) :: td_file 
    1044       TYPE(TFILE), INTENT(IN) :: td_coord 
    1045  
    1046       ! function 
    1047       TYPE(TVAR) :: create_restart_extract 
    1048  
    1049       ! local variable 
    1050       INTEGER(i4), DIMENSION(2,2,2) :: il_ind 
    1051  
    1052       INTEGER(i4) :: il_pivot 
    1053       INTEGER(i4) :: il_perio 
    1054  
    1055       INTEGER(i4) :: il_imin 
    1056       INTEGER(i4) :: il_jmin 
    1057       INTEGER(i4) :: il_imax 
    1058       INTEGER(i4) :: il_jmax 
    1059  
    1060       TYPE(TFILE) :: tl_file 
    1061  
    1062       TYPE(TMPP)  :: tl_mpp 
    1063  
    1064       TYPE(TATT)  :: tl_att 
    1065  
    1066       TYPE(TVAR)  :: tl_var 
    1067        
    1068       TYPE(TDOM)  :: tl_dom 
    1069       ! loop indices 
    1070       !---------------------------------------------------------------- 
    1071  
    1072       IF( td_file%i_id == 0 )THEN 
    1073          CALL logger_error("CREATE RESTART EXTRACT: file "//& 
    1074          &  TRIM(td_file%c_name)//" not opened ") 
    1075       ELSE 
    1076  
    1077          !init 
    1078          tl_file=td_file 
    1079  
    1080          !1- open file 
    1081          CALL iom_open(tl_file) 
    1082  
    1083          ! get periodicity 
    1084          il_pivot=grid_get_pivot(tl_file) 
    1085          il_perio=grid_get_perio(tl_file,il_pivot) 
    1086  
    1087          tl_file%i_perio=il_perio 
    1088  
    1089          !2- compute file grid indices around coord grid 
    1090          il_ind(:,:,:)=grid_get_coarse_index(tl_file, td_coord ) 
    1091  
    1092          il_imin=il_ind(1,1,1) ; il_imax=il_ind(1,2,1) 
    1093          il_jmin=il_ind(2,1,1) ; il_jmax=il_ind(2,2,1) 
    1094     
    1095          !3- check grid coincidence 
    1096          CALL grid_check_coincidence( tl_file, td_coord, & 
    1097          &                            il_imin, il_imax, & 
    1098          &                            il_jmin, il_jmax, & 
    1099          &                            (/1, 1, 1/) ) 
    1100  
    1101          !4- compute domain 
    1102          tl_dom=dom_init(tl_file,         & 
    1103          &               il_imin, il_imax, & 
    1104          &               il_jmin, il_jmax) 
    1105  
    1106          ! close file 
    1107          CALL iom_close(tl_file) 
    1108  
    1109          !5- read bathymetry on domain (ugly way to do it, have to work on it) 
    1110          !5-1 init mpp structure 
    1111          tl_mpp=mpp_init(tl_file) 
    1112  
    1113          CALL file_clean(tl_file) 
    1114  
    1115          !5-2 get processor to be used 
    1116          CALL mpp_get_use( tl_mpp, tl_dom ) 
    1117  
    1118          !5-3 open mpp files 
    1119          CALL iom_mpp_open(tl_mpp) 
    1120  
    1121          !5-4 read variable on domain 
    1122          tl_var=iom_mpp_read_var(tl_mpp,TRIM(td_var%c_name),td_dom=tl_dom) 
    1123  
    1124          !5-5 close mpp file 
    1125          CALL iom_mpp_close(tl_mpp) 
    1126  
    1127          !6- add ghost cell 
    1128          CALL grid_add_ghost(tl_var,tl_dom%i_ighost,tl_dom%i_jghost) 
    1129  
    1130          !7- check result 
    1131          IF( ANY( tl_var%t_dim(:)%l_use .AND. & 
    1132          &        tl_var%t_dim(:)%i_len /= td_coord%t_dim(:)%i_len) )THEN 
    1133             CALL logger_debug("CREATE BATHY EXTRACT: "//& 
    1134             &        "dimensoin of variable "//TRIM(td_var%c_name)//" "//& 
    1135             &        TRIM(fct_str(tl_var%t_dim(1)%i_len))//","//& 
    1136             &        TRIM(fct_str(tl_var%t_dim(2)%i_len))//","//& 
    1137             &        TRIM(fct_str(tl_var%t_dim(3)%i_len))//","//& 
    1138             &        TRIM(fct_str(tl_var%t_dim(4)%i_len)) ) 
    1139             CALL logger_debug("CREATE BATHY EXTRACT: "//& 
    1140             &        "dimensoin of coordinate file "//& 
    1141             &        TRIM(fct_str(td_coord%t_dim(1)%i_len))//","//& 
    1142             &        TRIM(fct_str(td_coord%t_dim(2)%i_len))//","//& 
    1143             &        TRIM(fct_str(td_coord%t_dim(3)%i_len))//","//& 
    1144             &        TRIM(fct_str(td_coord%t_dim(4)%i_len)) ) 
    1145             CALL logger_fatal("CREATE BATHY EXTRACT: "//& 
    1146             &  "dimensoin of extracted "//& 
    1147             &  "variable and coordinate file dimension differ") 
    1148          ENDIF 
    1149  
    1150          !8- add attribute to variable 
    1151          tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 
    1152          CALL var_move_att(tl_var, tl_att)          
    1153  
    1154          !9- save result 
    1155          create_restart_extract=tl_var 
    1156  
    1157          ! clean structure 
    1158          CALL var_clean(tl_var) 
    1159          CALL mpp_clean(tl_mpp) 
    1160       ENDIF 
    1161  
    1162    END FUNCTION create_restart_extract 
    1163    !> @endcode 
    1164    !------------------------------------------------------------------- 
    1165    !> @brief 
    1166    !> This subroutine 
    1167    !>  
    1168    !> @details  
    1169    !> 
    1170    !> @author J.Paul 
    1171    !> - Nov, 2013- Initial Version 
    1172    !> 
    1173    !> @param[in]  
    1174    !> @todo  
    1175    !------------------------------------------------------------------- 
    1176    !> @code 
    11771082   SUBROUTINE create_restart_interp( td_var, td_level,& 
    11781083   &                                 id_rho,          & 
     
    11911096 
    11921097      ! local variable 
    1193       TYPE(TVAR)  :: tl_var 
    1194  
    11951098      INTEGER(i4) :: il_iext 
    11961099      INTEGER(i4) :: il_jext 
     
    11981101      ! loop indices 
    11991102      !---------------------------------------------------------------- 
    1200  
    1201       ! copy variable 
    1202       tl_var=td_var 
    12031103 
    12041104      il_iext=3 
     
    12201120      ENDIF 
    12211121 
    1222       il_iext=0 
    1223       il_jext=0 
    1224  
    12251122      ! work on variable 
    1226       !1 add extraband 
    1227       CALL extrap_add_extrabands(tl_var, il_iext, il_jext) 
    1228  
    1229       !2 extrapolate variable 
    1230       CALL extrap_fill_value( tl_var, td_level(:),    & 
     1123      ! add extraband 
     1124      CALL extrap_add_extrabands(td_var, il_iext, il_jext) 
     1125 
     1126      ! extrapolate variable 
     1127      CALL extrap_fill_value( td_var, td_level(:),    & 
    12311128      &                               id_offset(:,:), & 
    12321129      &                               id_rho(:),      & 
    12331130      &                               id_iext=il_iext, id_jext=il_jext ) 
    12341131 
    1235       !3 interpolate variable 
    1236       CALL interp_fill_value( tl_var, id_rho(:), & 
     1132      ! interpolate variable 
     1133      CALL interp_fill_value( td_var, id_rho(:), & 
    12371134      &                       id_offset=id_offset(:,:) ) 
    12381135 
    1239       !4 remove extraband 
    1240       CALL extrap_del_extrabands(tl_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 
    1241  
    1242       !5- save result 
    1243       td_var=tl_var 
    1244  
    1245       ! clean variable structure 
    1246       CALL var_clean(tl_var) 
     1136      ! remove extraband 
     1137      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 
    12471138 
    12481139   END SUBROUTINE create_restart_interp 
    1249    !> @endcode 
     1140   !------------------------------------------------------------------- 
     1141   !> @brief 
     1142   !> This subroutine get depth variable value in an open mpp structure 
     1143   !> and check if agree with already input depth variable. 
     1144   !>  
     1145   !> @details  
     1146   !> 
     1147   !> @author J.Paul 
     1148   !> - November, 2014- Initial Version 
     1149   !> 
     1150   !> @param[in] td_mpp       mpp structure 
     1151   !> @param[inout] td_depth  depth variable structure  
     1152   !------------------------------------------------------------------- 
     1153   SUBROUTINE create_restart_check_depth( td_mpp, td_depth ) 
     1154 
     1155      IMPLICIT NONE 
     1156 
     1157      ! Argument 
     1158      TYPE(TMPP), INTENT(IN   ) :: td_mpp 
     1159      TYPE(TVAR), INTENT(INOUT) :: td_depth 
     1160 
     1161      ! local variable 
     1162      INTEGER(i4) :: il_varid 
     1163      TYPE(TVAR)  :: tl_depth 
     1164      ! loop indices 
     1165      !---------------------------------------------------------------- 
     1166 
     1167      ! get or check depth value 
     1168      IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN 
     1169 
     1170         il_varid=td_mpp%t_proc(1)%i_depthid 
     1171         IF( ASSOCIATED(td_depth%d_value) )THEN 
     1172 
     1173            tl_depth=iom_mpp_read_var(td_mpp, il_varid) 
     1174            IF( ANY( td_depth%d_value(:,:,:,:) /= & 
     1175            &        tl_depth%d_value(:,:,:,:) ) )THEN 
     1176 
     1177               CALL logger_fatal("CREATE BOUNDARY: depth value from "//& 
     1178               &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
     1179               &  " to those from former file(s).") 
     1180 
     1181            ENDIF 
     1182            CALL var_clean(tl_depth) 
     1183 
     1184         ELSE 
     1185            td_depth=iom_mpp_read_var(td_mpp,il_varid) 
     1186         ENDIF 
     1187 
     1188      ENDIF 
     1189       
     1190   END SUBROUTINE create_restart_check_depth 
     1191   !------------------------------------------------------------------- 
     1192   !> @brief 
     1193   !> This subroutine get date and time in an open mpp structure 
     1194   !> and check if agree with date and time already read. 
     1195   !>  
     1196   !> @details  
     1197   !> 
     1198   !> @author J.Paul 
     1199   !> - November, 2014- Initial Version 
     1200   !> 
     1201   !> @param[in] td_mpp      mpp structure 
     1202   !> @param[inout] td_time  time variable structure  
     1203   !------------------------------------------------------------------- 
     1204   SUBROUTINE create_restart_check_time( td_mpp, td_time ) 
     1205 
     1206      IMPLICIT NONE 
     1207 
     1208      ! Argument 
     1209      TYPE(TMPP), INTENT(IN   ) :: td_mpp 
     1210      TYPE(TVAR), INTENT(INOUT) :: td_time 
     1211 
     1212      ! local variable 
     1213      INTEGER(i4) :: il_varid 
     1214      TYPE(TVAR)  :: tl_time 
     1215 
     1216      TYPE(TDATE) :: tl_date1 
     1217      TYPE(TDATE) :: tl_date2 
     1218      ! loop indices 
     1219      !---------------------------------------------------------------- 
     1220 
     1221      ! get or check depth value 
     1222      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 
     1223 
     1224         il_varid=td_mpp%t_proc(1)%i_timeid 
     1225         IF( ASSOCIATED(td_time%d_value) )THEN 
     1226 
     1227            tl_time=iom_mpp_read_var(td_mpp, il_varid) 
     1228 
     1229            tl_date1=var_to_date(td_time) 
     1230            tl_date2=var_to_date(tl_time) 
     1231            IF( tl_date1 - tl_date2 /= 0 )THEN 
     1232 
     1233               CALL logger_fatal("CREATE BOUNDARY: date from "//& 
     1234               &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
     1235               &  " to those from former file(s).") 
     1236 
     1237            ENDIF 
     1238            CALL var_clean(tl_time) 
     1239 
     1240         ELSE 
     1241            td_time=iom_mpp_read_var(td_mpp,il_varid) 
     1242         ENDIF 
     1243 
     1244      ENDIF 
     1245       
     1246   END SUBROUTINE create_restart_check_time 
    12501247END PROGRAM create_restart 
Note: See TracChangeset for help on using the changeset viewer.