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 6392 for branches/2015/nemo_v3_6_STABLE/NEMOGCM – NEMO

Ignore:
Timestamp:
2016-03-17T10:15:57+01:00 (8 years ago)
Author:
jpaul
Message:

commit changes/bugfix/... for SIREN; see ticket #1700

Location:
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN
Files:
16 added
34 edited
3 moved

Legend:

Unmodified
Added
Removed
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg

    r5616 r6392  
    11# name       | units          | axis | pt| interpolation   | long name                             | standard name                                   
    2 X            | 1              | X    |   |                 |                                       | projection_x_coordinate                
    3 Y            | 1              | Y    |   |                 |                                       | projection_y_coordinate                
    4 Z            | 1              | Z    |   |                 |                                       | projection_z_coordinate                
    5 T            | 1              | T    |   |                 |                                       | projection_t_coordinate                
     2X            | unitless       | X    |   |                 |                                       | projection_x_coordinate                
     3Y            | unitless       | Y    |   |                 |                                       | projection_y_coordinate                
     4Z            | unitless       | Z    |   |                 |                                       | projection_z_coordinate                
     5T            | unitless       | T    |   |                 |                                       | projection_t_coordinate                
    66nav_lon      | degrees_east   | XY   | T | cubic           | Longitude                             | longitude                                    
    77nav_lat      | degrees_north  | XY   | T | cubic           | Latitude                              | latitude                          
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/Doxyfile

    r5037 r6392  
    4545# quick idea about the purpose of the project. Keep the description short. 
    4646 
    47 PROJECT_BRIEF          = "System and Interface for oceanic RElocable Nesting" 
     47PROJECT_BRIEF          = "System and Interface for oceanic RElocatable Nesting" 
    4848 
    4949# With the PROJECT_LOGO tag one can specify an logo or icon that is included in 
     
    20692069# The default value is: NO. 
    20702070 
    2071 HAVE_DOT               = YES 
     2071HAVE_DOT               = NO 
    20722072 
    20732073# The DOT_NUM_THREADS specifies the number of dot invocations doxygen is allowed 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/attribute.f90

    r5616 r6392  
    8383!> @date November, 2014  
    8484!> - Fix memory leaks bug 
     85!> @date September, 2015 
     86!> - manage useless (dummy) attributes 
    8587! 
    8688!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    98100   PUBLIC :: TATT       !< attribute structure 
    99101 
     102   PRIVATE :: cm_dumatt !< dummy attribute array 
     103 
    100104   ! function and subroutine 
    101105   PUBLIC :: att_init       !< initialize attribute structure 
     
    105109   PUBLIC :: att_get_index  !< get attribute index, in an array of attribute structure 
    106110   PUBLIC :: att_get_id     !< get attribute id, read from file 
     111   PUBLIC :: att_get_dummy  !< fill dummy attribute array 
     112   PUBLIC :: att_is_dummy   !< check if attribute is defined as dummy attribute 
    107113 
    108114   PRIVATE :: att__clean_unit ! clean attribute strcuture 
     
    135141   END TYPE TATT 
    136142 
     143   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumatt !< dummy attribute 
     144 
    137145   INTERFACE att_init 
    138146      MODULE PROCEDURE att__init_c     
     
    12511259 
    12521260   END SUBROUTINE att__clean_arr 
     1261   !------------------------------------------------------------------- 
     1262   !> @brief This subroutine fill dummy attribute array 
     1263   ! 
     1264   !> @author J.Paul 
     1265   !> @date September, 2015 - Initial Version 
     1266   !> @date Marsh, 2016 
     1267   !> - close file (bugfix) 
     1268   ! 
     1269   !> @param[in] cd_dummy dummy configuration file 
     1270   !------------------------------------------------------------------- 
     1271   SUBROUTINE att_get_dummy( cd_dummy ) 
     1272      IMPLICIT NONE 
     1273      ! Argument 
     1274      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy 
     1275 
     1276      ! local variable 
     1277      INTEGER(i4)   :: il_fileid 
     1278      INTEGER(i4)   :: il_status 
     1279 
     1280      LOGICAL       :: ll_exist 
     1281 
     1282      ! loop indices 
     1283      ! namelist 
     1284      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar 
     1285      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim 
     1286      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt 
     1287 
     1288      !---------------------------------------------------------------- 
     1289      NAMELIST /namdum/ &   !< dummy namelist 
     1290      &  cn_dumvar, &       !< variable  name 
     1291      &  cn_dumdim, &       !< dimension name 
     1292      &  cn_dumatt          !< attribute name 
     1293      !---------------------------------------------------------------- 
     1294 
     1295      ! init 
     1296      cm_dumatt(:)='' 
     1297 
     1298      ! read namelist 
     1299      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 
     1300      IF( ll_exist )THEN 
     1301     
     1302         il_fileid=fct_getunit() 
     1303    
     1304         OPEN( il_fileid, FILE=TRIM(cd_dummy), & 
     1305         &                FORM='FORMATTED',       & 
     1306         &                ACCESS='SEQUENTIAL',    & 
     1307         &                STATUS='OLD',           & 
     1308         &                ACTION='READ',          & 
     1309         &                IOSTAT=il_status) 
     1310         CALL fct_err(il_status) 
     1311         IF( il_status /= 0 )THEN 
     1312            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 
     1313         ENDIF 
     1314    
     1315         READ( il_fileid, NML = namdum ) 
     1316         cm_dumatt(:)=cn_dumatt(:) 
     1317 
     1318         CLOSE( il_fileid ) 
     1319 
     1320      ENDIF 
     1321    
     1322   END SUBROUTINE att_get_dummy 
     1323   !------------------------------------------------------------------- 
     1324   !> @brief This function check if attribute is defined as dummy attribute 
     1325   !> in configuraton file 
     1326   !> 
     1327   !> @author J.Paul 
     1328   !> @date September, 2015 - Initial Version 
     1329   ! 
     1330   !> @param[in] td_att attribute structure 
     1331   !> @return true if attribute is dummy attribute 
     1332   !------------------------------------------------------------------- 
     1333   FUNCTION att_is_dummy(td_att) 
     1334      IMPLICIT NONE 
     1335 
     1336      ! Argument       
     1337      TYPE(TATT), INTENT(IN) :: td_att 
     1338       
     1339      ! function 
     1340      LOGICAL :: att_is_dummy 
     1341       
     1342      ! loop indices 
     1343      INTEGER(i4) :: ji 
     1344      !---------------------------------------------------------------- 
     1345 
     1346      att_is_dummy=.FALSE. 
     1347      DO ji=1,ip_maxdum 
     1348         IF( fct_lower(td_att%c_name) == fct_lower(cm_dumatt(ji)) )THEN 
     1349            att_is_dummy=.TRUE. 
     1350            EXIT 
     1351         ENDIF 
     1352      ENDDO 
     1353 
     1354   END FUNCTION att_is_dummy 
    12531355END MODULE att 
    12541356 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/boundary.f90

    r5608 r6392  
    482482   !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2' 
    483483   !> 
    484    !> @note Boundaries are compute on T point, but expressed on U,V point. 
     484   !> @warn Boundaries are compute on T point, but expressed on U,V point. 
    485485   !> change will be done to get data on other point when need be.  
    486486   !> 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90

    r5616 r6392  
    88!> @file 
    99!> @brief  
    10 !> This program create fine grid bathymetry file. 
     10!> This program creates fine grid bathymetry file. 
    1111!> 
    1212!> @details 
     
    2727!>    you could find a template of the namelist in templates directory. 
    2828!> 
    29 !>    create_bathy.nam comprise 7 namelists:<br/> 
     29!>    create_bathy.nam contains 7 namelists:<br/> 
    3030!>       - logger namelist (namlog) 
    3131!>       - config namelist (namcfg) 
     
    3636!>       - output namelist (namout) 
    3737!>     
    38 !>    @note  
    39 !>       All namelists have to be in file create_bathy.nam, however variables of 
    40 !>       those namelists are all optional. 
    41 !> 
    4238!>    * _logger namelist (namlog)_:<br/> 
    4339!>       - cn_logfile   : log filename 
     
    4945!>       - cn_varcfg : variable configuration file  
    5046!> (see ./SIREN/cfg/variable.cfg) 
     47!>       - cn_dumcfg : useless (dummy) configuration file, for useless  
     48!> dimension or variable (see ./SIREN/cfg/dummy.cfg). 
    5149!> 
    5250!>    * _coarse grid namelist (namcrs)_:<br/> 
     
    6159!> 
    6260!>    * _variable namelist (namvar)_:<br/> 
    63 !>       - cn_varinfo : list of variable and extra information about request(s)  
    64 !>       to be used.<br/> 
    65 !>          each elements of *cn_varinfo* is a string character 
    66 !>          (separated by ',').<br/> 
    67 !>          it is composed of the variable name follow by ':',  
    68 !>          then request(s) to be used on this variable.<br/>  
    69 !>          request could be: 
    70 !>             - int = interpolation method 
    71 !>             - ext = extrapolation method 
    72 !>             - flt = filter method 
    73 !>             - min = minimum value 
    74 !>             - max = maximum value 
    75 !>             - unt = new units 
    76 !>             - unf = unit scale factor (linked to new units) 
    77 !> 
    78 !>                requests must be separated by ';'.<br/> 
    79 !>                order of requests does not matter.<br/> 
    80 !> 
    81 !>          informations about available method could be find in @ref interp, 
    82 !>          @ref extrap and @ref filter modules.<br/> 
    83 !>          Example: 'Bathymetry: flt=2*hamming(2,3); min=0' 
    84 !>          @note  
    85 !>             If you do not specify a method which is required,  
    86 !>             default one is apply. 
    87 !>          @warning  
    88 !>             variable name must be __Bathymetry__ here. 
    8961!>       - cn_varfile : list of variable, and corresponding file.<br/>  
    9062!>          *cn_varfile* is the path and filename of the file where find 
     
    10880!>             - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000' 
    10981!> 
     82!>       - cn_varinfo : list of variable and extra information about request(s)  
     83!>       to be used.<br/> 
     84!>          each elements of *cn_varinfo* is a string character 
     85!>          (separated by ',').<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!>             - int = interpolation method 
     90!>             - ext = extrapolation method 
     91!>             - flt = filter method 
     92!>             - min = minimum value 
     93!>             - max = maximum value 
     94!>             - unt = new units 
     95!>             - unf = unit scale factor (linked to new units) 
     96!> 
     97!>                requests must be separated by ';'.<br/> 
     98!>                order of requests does not matter.<br/> 
     99!> 
     100!>          informations about available method could be find in @ref interp, 
     101!>          @ref extrap and @ref filter modules.<br/> 
     102!>          Example: 'Bathymetry: flt=2*hamming(2,3); min=0' 
     103!>          @note  
     104!>             If you do not specify a method which is required,  
     105!>             default one is apply. 
     106!>          @warning  
     107!>             variable name must be __Bathymetry__ here. 
     108!> 
    110109!>    * _nesting namelist (namnst)_:<br/> 
    111110!>       - in_rhoi  : refinement factor in i-direction 
     
    127126!> - extrapolate all land points. 
    128127!> - allow to change unit. 
     128!> @date September, 2015 
     129!> - manage useless (dummy) variable, attributes, and dimension 
     130!> @date January,2016 
     131!> - add create_bathy_check_depth as in create_boundary 
     132!> - add create_bathy_check_time  as in create_boundary 
     133!> @date February, 2016 
     134!> - do not closed sea for east-west cyclic domain 
    129135! 
    130136!> @todo 
    131 !> - use create_bathy_check_depth as in create_boundary 
    132 !> - use create_bathy_check_time  as in create_boundary 
    133137!> - check tl_multi is not empty 
    134138!> 
     
    167171   INTEGER(i4)                                        :: il_status 
    168172   INTEGER(i4)                                        :: il_fileid 
    169    INTEGER(i4)                                        :: il_varid 
    170173   INTEGER(i4)                                        :: il_attid 
    171174   INTEGER(i4)                                        :: il_imin0 
     
    179182 
    180183   LOGICAL                                            :: ll_exist 
     184   LOGICAL                                            :: ll_fillclosed 
    181185 
    182186   TYPE(TMPP)                                         :: tl_coord0 
     
    208212   ! namelist variable 
    209213   ! namlog 
    210    CHARACTER(LEN=lc) :: cn_logfile = 'create_bathy.log'  
    211    CHARACTER(LEN=lc) :: cn_verbosity = 'warning'  
    212    INTEGER(i4)       :: in_maxerror = 5 
     214   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_bathy.log'  
     215   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning'  
     216   INTEGER(i4)                             :: in_maxerror = 5 
    213217 
    214218   ! namcfg 
    215    CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg'  
     219   CHARACTER(LEN=lc)                       :: cn_varcfg = './cfg/variable.cfg'  
     220   CHARACTER(LEN=lc)                       :: cn_dumcfg = './cfg/dummy.cfg'  
    216221 
    217222   ! namcrs 
    218    CHARACTER(LEN=lc) :: cn_coord0 = ''  
    219    INTEGER(i4)       :: in_perio0 = -1 
     223   CHARACTER(LEN=lc)                       :: cn_coord0 = ''  
     224   INTEGER(i4)                             :: in_perio0 = -1 
    220225 
    221226   ! namfin 
    222    CHARACTER(LEN=lc) :: cn_coord1 = '' 
    223    INTEGER(i4)       :: in_perio1 = -1 
    224    LOGICAL           :: ln_fillclosed = .TRUE. 
     227   CHARACTER(LEN=lc)                       :: cn_coord1 = '' 
     228   INTEGER(i4)                             :: in_perio1 = -1 
     229   LOGICAL                                 :: ln_fillclosed = .TRUE. 
    225230 
    226231   ! namvar 
     232   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
    227233   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
    228    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
    229234 
    230235   ! namnst 
    231    INTEGER(i4)       :: in_rhoi  = 1 
    232    INTEGER(i4)       :: in_rhoj  = 1 
     236   INTEGER(i4)                             :: in_rhoi  = 1 
     237   INTEGER(i4)                             :: in_rhoj  = 1 
    233238 
    234239   ! namout 
    235    CHARACTER(LEN=lc) :: cn_fileout = 'bathy_fine.nc'  
     240   CHARACTER(LEN=lc)                       :: cn_fileout = 'bathy_fine.nc'  
    236241   !------------------------------------------------------------------- 
    237242 
     
    242247 
    243248   NAMELIST /namcfg/ &   !< configuration namelist 
    244    &  cn_varcfg          !< variable configuration file 
     249   &  cn_varcfg, &       !< variable configuration file 
     250   &  cn_dumcfg          !< dummy configuration file 
    245251 
    246252   NAMELIST /namcrs/ &   !< coarse grid namelist 
     
    254260  
    255261   NAMELIST /namvar/ &   !< variable namelist 
    256    &  cn_varinfo, &      !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' ) 
    257    &  cn_varfile         !< list of variable file 
     262   &  cn_varfile, &      !< list of variable file 
     263   &  cn_varinfo         !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' ) 
    258264    
    259265   NAMELIST /namnst/ &   !< nesting namelist 
     
    302308      CALL var_def_extra(TRIM(cn_varcfg)) 
    303309 
     310      ! get dummy variable 
     311      CALL var_get_dummy(TRIM(cn_dumcfg)) 
     312      ! get dummy dimension 
     313      CALL dim_get_dummy(TRIM(cn_dumcfg)) 
     314      ! get dummy attribute 
     315      CALL att_get_dummy(TRIM(cn_dumcfg)) 
     316 
    304317      READ( il_fileid, NML = namcrs ) 
    305318      READ( il_fileid, NML = namfin ) 
     
    309322      ! match variable with file 
    310323      tl_multi=multi_init(cn_varfile) 
    311        
     324  
    312325      READ( il_fileid, NML = namnst ) 
    313326      READ( il_fileid, NML = namout ) 
     
    322335 
    323336      PRINT *,"ERROR in create_bathy: can't find "//TRIM(cl_namelist) 
     337      STOP 
    324338 
    325339   ENDIF 
     
    343357      &     "check namelist") 
    344358   ENDIF 
     359 
     360   ! do not closed sea for east-west cyclic domain 
     361   ll_fillclosed=ln_fillclosed 
     362   IF( tl_coord1%i_perio == 1 ) ll_fillclosed=.FALSE. 
    345363 
    346364   ! check 
     
    417435 
    418436            ! get or check depth value 
    419             IF( tl_multi%t_mpp(ji)%t_proc(1)%i_depthid /= 0 )THEN 
    420                il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_depthid 
    421                IF( ASSOCIATED(tl_depth%d_value) )THEN 
    422                   tl_tmp=iom_mpp_read_var(tl_mpp,il_varid) 
    423                   IF( ANY( tl_depth%d_value(:,:,:,:) /= & 
    424                   &        tl_tmp%d_value(:,:,:,:) ) )THEN 
    425                      CALL logger_fatal("CREATE BATHY: depth value from "//& 
    426                      &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
    427                      &  " to those from former file(s).") 
    428                   ENDIF 
    429                   CALL var_clean(tl_tmp) 
    430                ELSE 
    431                   tl_depth=iom_mpp_read_var(tl_mpp,il_varid) 
    432                ENDIF 
    433             ENDIF 
     437            CALL create_bathy_check_depth( tl_mpp, tl_depth ) 
    434438 
    435439            ! get or check time value 
    436             IF( tl_multi%t_mpp(ji)%t_proc(1)%i_timeid /= 0 )THEN 
    437                il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_timeid 
    438                IF( ASSOCIATED(tl_time%d_value) )THEN 
    439                   tl_tmp=iom_mpp_read_var(tl_mpp,il_varid) 
    440                   IF( ANY( tl_time%d_value(:,:,:,:) /= & 
    441                   &        tl_tmp%d_value(:,:,:,:) ) )THEN 
    442                      CALL logger_fatal("CREATE BATHY: time value from "//& 
    443                      &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
    444                      &  " to those from former file(s).") 
    445                   ENDIF 
    446                   CALL var_clean(tl_tmp) 
    447                ELSE 
    448                   tl_time=iom_mpp_read_var(tl_mpp,il_varid) 
    449                ENDIF 
    450             ENDIF 
     440            CALL create_bathy_check_time( tl_mpp, tl_time ) 
    451441 
    452442            ! close mpp file 
    453443            CALL iom_mpp_close(tl_mpp) 
    454444 
    455             IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 
    456             &        tl_coord0%t_dim(1:2)%i_len) )THEN 
     445            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len).OR.& 
     446            &   ALL(il_rho(:)==1) )THEN 
    457447               !- extract bathymetry from fine grid bathymetry  
    458448               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     
    505495 
    506496         ! fill closed sea 
    507          IF( ln_fillclosed )THEN 
     497         IF( ll_fillclosed )THEN 
    508498            ALLOCATE( il_mask(tl_var(jk)%t_dim(1)%i_len, & 
    509499            &                 tl_var(jk)%t_dim(2)%i_len) ) 
     
    526516         &   dl_minbat <= 0._dp  )THEN 
    527517            CALL logger_debug("CREATE BATHY: min value "//TRIM(fct_str(dl_minbat))) 
    528             CALL logger_error("CREATE BATHY: Bathymetry has value <= 0") 
     518            CALL logger_fatal("CREATE BATHY: Bathymetry has value <= 0") 
    529519         ENDIF 
    530520 
     
    973963      CALL dom_del_extra( tl_var, tl_dom, il_rho(:) ) 
    974964 
     965      CALL dom_clean_extra( tl_dom ) 
     966 
    975967      !- add ghost cell 
    976968      CALL grid_add_ghost(tl_var,tl_dom%i_ghost(:,:)) 
     
    11091101 
    11101102   END SUBROUTINE create_bathy_interp 
     1103   !------------------------------------------------------------------- 
     1104   !> @brief 
     1105   !> This subroutine get depth variable value in an open mpp structure 
     1106   !> and check if agree with already input depth variable. 
     1107   !>  
     1108   !> @details  
     1109   !> 
     1110   !> @author J.Paul 
     1111   !> @date January, 2016 - Initial Version 
     1112   !> 
     1113   !> @param[in] td_mpp       mpp structure 
     1114   !> @param[inout] td_depth  depth variable structure  
     1115   !------------------------------------------------------------------- 
     1116   SUBROUTINE create_bathy_check_depth( td_mpp, td_depth ) 
     1117 
     1118      IMPLICIT NONE 
     1119 
     1120      ! Argument 
     1121      TYPE(TMPP) , INTENT(IN   ) :: td_mpp 
     1122      TYPE(TVAR) , INTENT(INOUT) :: td_depth 
     1123 
     1124      ! local variable 
     1125      INTEGER(i4) :: il_varid 
     1126      TYPE(TVAR)  :: tl_depth 
     1127      ! loop indices 
     1128      !---------------------------------------------------------------- 
     1129 
     1130      ! get or check depth value 
     1131      IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN 
     1132 
     1133         il_varid=td_mpp%t_proc(1)%i_depthid 
     1134         IF( ASSOCIATED(td_depth%d_value) )THEN 
     1135 
     1136            tl_depth=iom_mpp_read_var(td_mpp, il_varid) 
     1137 
     1138            IF( ANY( td_depth%d_value(:,:,:,:) /= & 
     1139            &        tl_depth%d_value(:,:,:,:) ) )THEN 
     1140 
     1141               CALL logger_warn("CREATE BATHY: depth value from "//& 
     1142               &  TRIM(td_mpp%c_name)//" not conform "//& 
     1143               &  " to those from former file(s).") 
     1144 
     1145            ENDIF 
     1146            CALL var_clean(tl_depth) 
     1147 
     1148         ELSE 
     1149            td_depth=iom_mpp_read_var(td_mpp,il_varid) 
     1150         ENDIF 
     1151 
     1152      ENDIF 
     1153       
     1154   END SUBROUTINE create_bathy_check_depth 
     1155   !------------------------------------------------------------------- 
     1156   !> @brief 
     1157   !> This subroutine get date and time in an open mpp structure 
     1158   !> and check if agree with date and time already read. 
     1159   !>  
     1160   !> @details  
     1161   !> 
     1162   !> @author J.Paul 
     1163   !> @date January, 2016 - Initial Version 
     1164   !> 
     1165   !> @param[in] td_mpp      mpp structure 
     1166   !> @param[inout] td_time  time variable structure  
     1167   !------------------------------------------------------------------- 
     1168   SUBROUTINE create_bathy_check_time( td_mpp, td_time ) 
     1169 
     1170      IMPLICIT NONE 
     1171 
     1172      ! Argument 
     1173      TYPE(TMPP), INTENT(IN   ) :: td_mpp 
     1174      TYPE(TVAR), INTENT(INOUT) :: td_time 
     1175 
     1176      ! local variable 
     1177      INTEGER(i4) :: il_varid 
     1178      TYPE(TVAR)  :: tl_time 
     1179 
     1180      TYPE(TDATE) :: tl_date1 
     1181      TYPE(TDATE) :: tl_date2 
     1182      ! loop indices 
     1183      !---------------------------------------------------------------- 
     1184 
     1185      ! get or check depth value 
     1186      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 
     1187 
     1188         il_varid=td_mpp%t_proc(1)%i_timeid 
     1189         IF( ASSOCIATED(td_time%d_value) )THEN 
     1190 
     1191            tl_time=iom_mpp_read_var(td_mpp, il_varid) 
     1192 
     1193            tl_date1=var_to_date(td_time) 
     1194            tl_date2=var_to_date(tl_time) 
     1195            IF( tl_date1 - tl_date2 /= 0 )THEN 
     1196 
     1197               CALL logger_warn("CREATE BATHY: date from "//& 
     1198               &  TRIM(td_mpp%c_name)//" not conform "//& 
     1199               &  " to those from former file(s).") 
     1200 
     1201            ENDIF 
     1202            CALL var_clean(tl_time) 
     1203 
     1204         ELSE 
     1205            td_time=iom_mpp_read_var(td_mpp,il_varid) 
     1206         ENDIF 
     1207 
     1208      ENDIF 
     1209       
     1210   END SUBROUTINE create_bathy_check_time 
    11111211END PROGRAM create_bathy 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/create_boundary.F90

    r6391 r6392  
    99!> @file 
    1010!> @brief  
    11 !> This program create boundary files. 
     11!> This program creates boundary files. 
    1212!> 
    1313!> @details 
    1414!> @section sec1 method 
    15 !> Variables are read from coarse grid standard output  
    16 !> and interpolated on fine grid or manually written.<br/> 
     15!> Variables are read from coarse grid standard output,  
     16!> extracted or interpolated on fine grid.  
     17!> Variables could also be manually written.<br/> 
    1718!> @note  
    1819!>    method could be different for each variable. 
     
    3031!>    you could find a template of the namelist in templates directory. 
    3132!> 
    32 !>    create_boundary.nam comprise 9 namelists:<br/> 
     33!>    create_boundary.nam contains 9 namelists:<br/> 
    3334!>       - logger namelist (namlog) 
    3435!>       - config namelist (namcfg) 
     
    4142!>       - output namelist (namout) 
    4243!>     
    43 !>    @note  
    44 !>       All namelists have to be in file create_boundary.nam,  
    45 !>       however variables of those namelists are all optional. 
    46 !> 
    4744!>    * _logger namelist (namlog)_:<br/> 
    4845!>       - cn_logfile   : log filename 
     
    5451!>       - cn_varcfg : variable configuration file 
    5552!> (see ./SIREN/cfg/variable.cfg) 
     53!>       - cn_dumcfg : useless (dummy) configuration file, for useless  
     54!> dimension or variable (see ./SIREN/cfg/dummy.cfg). 
    5655!> 
    5756!>    * _coarse grid namelist (namcrs)_:<br/> 
     
    8079!> 
    8180!>    * _partial step namelist (namzps)_:<br/> 
    82 !>       - dn_e3zps_mi           : 
     81!>       - dn_e3zps_min          : 
    8382!>       - dn_e3zps_rat          :  
    8483!> 
    8584!>    * _variable namelist (namvar)_:<br/> 
    86 !>       - cn_varinfo : list of variable and extra information about request(s) 
    87 !>          to be used (separated by ',').<br/> 
    88 !>          each elements of *cn_varinfo* is a string character.<br/> 
    89 !>          it is composed of the variable name follow by ':',  
    90 !>          then request(s) to be used on this variable.<br/>  
    91 !>          request could be: 
    92 !>             - int = interpolation method 
    93 !>             - ext = extrapolation method 
    94 !>             - flt = filter method 
    95 !>             - unt = new units 
    96 !>             - unf = unit scale factor (linked to new units) 
    97 !> 
    98 !>                requests must be separated by ';'.<br/> 
    99 !>                order of requests does not matter. 
    100 !> 
    101 !>          informations about available method could be find in @ref interp, 
    102 !>          @ref extrap and @ref filter.<br/> 
    103 !> 
    104 !>          Example: 'votemper:int=linear;flt=hann;ext=dist_weight', 'vosaline:int=cubic' 
    105 !>          @note  
    106 !>             If you do not specify a method which is required,  
    107 !>             default one is apply. 
    108 !>       - cn_varfile : list of variable, and corresponding file<br/>  
     85!>       - cn_varfile : list of variable, and associated file<br/>  
    10986!>          *cn_varfile* is the path and filename of the file where find 
    11087!>          variable.<br/>  
     
    12198!>                Example:<br/> 
    12299!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc} 
    123 !>                                         3 & 2 & 3 \\ 
     100!>                                         3 & 2 & 3 \\\\ 
    124101!>                                         1 & 4 & 5 \end{array} \right) @f$ 
    125102!>          @warning  
     
    129106!>          - 'votemper:gridT.nc', 'vozocrtx:gridU.nc' 
    130107!>          - 'votemper:10\25', 'vozocrtx:gridU.nc' 
     108!> 
     109!>       - cn_varinfo : list of variable and extra information about request(s) 
     110!>          to be used (separated by ',').<br/> 
     111!>          each elements of *cn_varinfo* is a string character.<br/> 
     112!>          it is composed of the variable name follow by ':',  
     113!>          then request(s) to be used on this variable.<br/>  
     114!>          request could be: 
     115!>             - int = interpolation method 
     116!>             - ext = extrapolation method 
     117!>             - flt = filter method 
     118!>             - min = minimum value 
     119!>             - max = maximum value 
     120!>             - unt = new units 
     121!>             - unf = unit scale factor (linked to new units) 
     122!> 
     123!>                requests must be separated by ';'.<br/> 
     124!>                order of requests does not matter. 
     125!> 
     126!>          informations about available method could be find in @ref interp, 
     127!>          @ref extrap and @ref filter.<br/> 
     128!> 
     129!>          Example: 'votemper:int=linear;flt=hann;ext=dist_weight',  
     130!>                   'vosaline:int=cubic' 
     131!>          @note  
     132!>             If you do not specify a method which is required,  
     133!>             default one is apply. 
    131134!> 
    132135!>    * _nesting namelist (namnst)_:<br/> 
     
    146149!>             - indice of velocity (orthogonal to boundary .ie.  
    147150!>                for north boundary, J-indice).  
    148 !>             - indice of segemnt start (I-indice for north boundary)  
     151!>             - indice of segment start (I-indice for north boundary)  
    149152!>             - indice of segment end   (I-indice for north boundary)<br/> 
    150153!>                indices must be separated by ':' .<br/> 
    151154!>             - optionally, boundary size could be added between '(' and ')'  
    152 !>             in the first segment defined. 
     155!>             in the definition of the first segment. 
    153156!>                @note  
    154157!>                   boundary width is the same for all segments of one boundary. 
     
    162165!>       - cn_east   : east  boundary indices on fine grid 
    163166!>       - cn_west   : west  boundary indices on fine grid 
    164 !>       - ln_oneseg : use only one segment for each boundary or not 
     167!>       - ln_oneseg : force to use only one segment for each boundary or not 
    165168!> 
    166169!>    * _output namelist (namout)_:<br/> 
    167170!>       - cn_fileout : fine grid boundary basename 
    168 !>         (cardinal and segment number will be automatically added) 
     171!>         (cardinal point and segment number will be automatically added) 
    169172!>       - dn_dayofs  : date offset in day (change only ouput file name) 
    170173!>       - ln_extrap  : extrapolate land point or not 
    171174!> 
    172175!>          Examples:  
    173 !>             - cn_fileout=boundary.nc<br/> 
     176!>             - cn_fileout='boundary.nc'<br/> 
    174177!>                if time_counter (16/07/2015 00h) is read on input file (see varfile),  
    175178!>                west boundary will be named boundary_west_y2015m07d16 
     
    189192!> - allow to change unit. 
    190193!> @date July, 2015 
    191 !> - add namelist parameter to shift date of output file name.   
     194!> - add namelist parameter to shift date of output file name. 
     195!> @date September, 2015 
     196!> - manage useless (dummy) variable, attributes, and dimension 
     197!> - allow to run on multi processors with key_mpp_mpi 
     198!> @date January, 2016 
     199!> - same process use for variable extracted or interpolated from input file. 
    192200!> 
    193201!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    199207   USE phycst                          ! physical constant 
    200208   USE kind                            ! F90 kind parameter 
    201    USE logger                          ! log file manager 
    202209   USE fct                             ! basic useful function 
    203210   USE date                            ! date manager 
     
    221228 
    222229   ! local variable 
     230   INTEGER(i4)                                        :: il_narg 
     231 
     232#if defined key_mpp_mpi 
     233   ! mpp variable 
     234   CHARACTER(LEN=lc), DIMENSION(:)      , ALLOCATABLE :: cl_namelist 
     235   INTEGER(i4)                                        :: ierror 
     236   INTEGER(i4)                                        :: iproc 
     237   INTEGER(i4)                                        :: nproc 
     238   INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_nprog 
     239 
     240   ! loop indices 
     241   INTEGER(i4) :: jm 
     242#else 
    223243   CHARACTER(LEN=lc)                                  :: cl_namelist 
     244#endif 
     245   !------------------------------------------------------------------- 
     246#if defined key_mpp_mpi 
     247   INCLUDE 'mpif.h' 
     248#endif 
     249   !------------------------------------------------------------------- 
     250 
     251   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec 
     252#if ! defined key_mpp_mpi 
     253 
     254   IF( il_narg/=1 )THEN 
     255      PRINT *,"CREATE BOUNDARY: ERROR. need one namelist" 
     256      STOP 
     257   ELSE 
     258      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec 
     259   ENDIF 
     260 
     261   CALL create__boundary(cl_namelist) 
     262 
     263#else 
     264 
     265   ! Initialize MPI 
     266   CALL mpi_init(ierror) 
     267   CALL mpi_comm_rank(mpi_comm_world,iproc,ierror) 
     268   CALL mpi_comm_size(mpi_comm_world,nproc,ierror) 
     269 
     270   IF( il_narg==0 )THEN 
     271      PRINT *,"CREATE BOUNDARY: ERROR. need at least one namelist" 
     272      STOP 
     273   ELSE 
     274      ALLOCATE(cl_namelist(il_narg)) 
     275      DO jm=1,il_narg 
     276         CALL GET_COMMAND_ARGUMENT(jm,cl_namelist(jm)) 
     277      ENDDO 
     278   ENDIF 
     279 
     280   ALLOCATE(il_nprog(il_narg)) 
     281   DO jm=1, il_narg 
     282      il_nprog(jm)= MOD(jm,nproc) 
     283   ENDDO 
     284 
     285   DO jm=1, il_narg 
     286      IF ( il_nprog(jm) .eq. iproc ) THEN 
     287         CALL create__boundary(cl_namelist(jm)) 
     288      ENDIF 
     289   ENDDO 
     290 
     291   CALL mpi_finalize(ierror) 
     292 
     293   DEALLOCATE(cl_namelist) 
     294   DEALLOCATE(il_nprog) 
     295#endif 
     296 
     297CONTAINS 
     298SUBROUTINE create__boundary(cd_namelist) 
     299   !------------------------------------------------------------------- 
     300   !> @brief 
     301   !> This subroutine create boundary files. 
     302   !>  
     303   !> @details  
     304   !> 
     305   !> @author J.Paul 
     306   !> @date January, 2016 - Initial Version 
     307   !> 
     308   !> @param[in] cd_namelist namelist file  
     309   !------------------------------------------------------------------- 
     310 
     311   USE logger                          ! log file manager 
     312 
     313   IMPLICIT NONE 
     314   ! Argument 
     315   CHARACTER(LEN=lc), INTENT(IN) :: cd_namelist  
     316 
     317   ! local variable 
    224318   CHARACTER(LEN=lc)                                  :: cl_date 
    225319   CHARACTER(LEN=lc)                                  :: cl_name 
     
    227321   CHARACTER(LEN=lc)                                  :: cl_data 
    228322   CHARACTER(LEN=lc)                                  :: cl_dimorder 
    229    CHARACTER(LEN=lc)                                  :: cl_point 
    230323   CHARACTER(LEN=lc)                                  :: cl_fmt 
    231324 
    232    INTEGER(i4)                                        :: il_narg 
    233325   INTEGER(i4)                                        :: il_status 
    234326   INTEGER(i4)                                        :: il_fileid 
     
    286378   ! namelist variable 
    287379   ! namlog 
    288    CHARACTER(LEN=lc)  :: cn_logfile = 'create_boundary.log'  
    289    CHARACTER(LEN=lc)  :: cn_verbosity = 'warning'  
    290    INTEGER(i4)        :: in_maxerror = 5 
     380   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_boundary.log'  
     381   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning'  
     382   INTEGER(i4)                             :: in_maxerror = 5 
    291383 
    292384   ! namcfg 
    293    CHARACTER(LEN=lc)  :: cn_varcfg = 'variable.cfg'  
     385   CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg'  
     386   CHARACTER(LEN=lc)                       :: cn_dumcfg = 'dummy.cfg' 
    294387 
    295388   ! namcrs 
    296    CHARACTER(LEN=lc)  :: cn_coord0 = ''  
    297    INTEGER(i4)        :: in_perio0 = -1 
     389   CHARACTER(LEN=lc)                       :: cn_coord0 = ''  
     390   INTEGER(i4)                             :: in_perio0 = -1 
    298391 
    299392   ! namfin 
    300    CHARACTER(LEN=lc)  :: cn_coord1 = ''  
    301    CHARACTER(LEN=lc)  :: cn_bathy1 = ''  
    302    INTEGER(i4)        :: in_perio1 = -1 
     393   CHARACTER(LEN=lc)                       :: cn_coord1 = ''  
     394   CHARACTER(LEN=lc)                       :: cn_bathy1 = ''  
     395   INTEGER(i4)                             :: in_perio1 = -1 
    303396 
    304397   !namzgr 
    305    REAL(dp)          :: dn_pp_to_be_computed = 0._dp 
    306    REAL(dp)          :: dn_ppsur     = -3958.951371276829_dp 
    307    REAL(dp)          :: dn_ppa0      =   103.9530096000000_dp 
    308    REAL(dp)          :: dn_ppa1      =     2.4159512690000_dp 
    309    REAL(dp)          :: dn_ppa2      =   100.7609285000000_dp 
    310    REAL(dp)          :: dn_ppkth     =    15.3510137000000_dp 
    311    REAL(dp)          :: dn_ppkth2    =    48.0298937200000_dp 
    312    REAL(dp)          :: dn_ppacr     =     7.0000000000000_dp 
    313    REAL(dp)          :: dn_ppacr2    =    13.000000000000_dp 
    314    REAL(dp)          :: dn_ppdzmin  = 6._dp 
    315    REAL(dp)          :: dn_pphmax    = 5750._dp 
    316    INTEGER(i4)       :: in_nlevel    = 75 
     398   REAL(dp)                                :: dn_pp_to_be_computed = 0._dp 
     399   REAL(dp)                                :: dn_ppsur   = -3958.951371276829_dp 
     400   REAL(dp)                                :: dn_ppa0    =   103.953009600000_dp 
     401   REAL(dp)                                :: dn_ppa1    =     2.415951269000_dp 
     402   REAL(dp)                                :: dn_ppa2    =   100.760928500000_dp 
     403   REAL(dp)                                :: dn_ppkth   =    15.351013700000_dp 
     404   REAL(dp)                                :: dn_ppkth2  =    48.029893720000_dp 
     405   REAL(dp)                                :: dn_ppacr   =     7.000000000000_dp 
     406   REAL(dp)                                :: dn_ppacr2  =    13.000000000000_dp 
     407   REAL(dp)                                :: dn_ppdzmin = 6._dp 
     408   REAL(dp)                                :: dn_pphmax  = 5750._dp 
     409   INTEGER(i4)                             :: in_nlevel  = 75 
    317410 
    318411   !namzps 
    319    REAL(dp)          :: dn_e3zps_min = 25._dp 
    320    REAL(dp)          :: dn_e3zps_rat = 0.2_dp 
     412   REAL(dp)                                :: dn_e3zps_min = 25._dp 
     413   REAL(dp)                                :: dn_e3zps_rat = 0.2_dp 
    321414 
    322415   ! namvar 
     416   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
    323417   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
    324    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
    325418 
    326419   ! namnst 
    327    INTEGER(i4)       :: in_rhoi  = 0 
    328    INTEGER(i4)       :: in_rhoj  = 0 
     420   INTEGER(i4)                             :: in_rhoi  = 0 
     421   INTEGER(i4)                             :: in_rhoj  = 0 
    329422 
    330423   ! nambdy 
    331    LOGICAL           :: ln_north   = .TRUE. 
    332    LOGICAL           :: ln_south   = .TRUE. 
    333    LOGICAL           :: ln_east    = .TRUE. 
    334    LOGICAL           :: ln_west    = .TRUE. 
    335    CHARACTER(LEN=lc) :: cn_north   = '' 
    336    CHARACTER(LEN=lc) :: cn_south   = '' 
    337    CHARACTER(LEN=lc) :: cn_east    = '' 
    338    CHARACTER(LEN=lc) :: cn_west    = '' 
    339    LOGICAL           :: ln_oneseg  = .TRUE. 
     424   LOGICAL                                 :: ln_north   = .TRUE. 
     425   LOGICAL                                 :: ln_south   = .TRUE. 
     426   LOGICAL                                 :: ln_east    = .TRUE. 
     427   LOGICAL                                 :: ln_west    = .TRUE. 
     428   LOGICAL                                 :: ln_oneseg  = .TRUE. 
     429   CHARACTER(LEN=lc)                       :: cn_north   = '' 
     430   CHARACTER(LEN=lc)                       :: cn_south   = '' 
     431   CHARACTER(LEN=lc)                       :: cn_east    = '' 
     432   CHARACTER(LEN=lc)                       :: cn_west    = '' 
    340433 
    341434   ! namout 
    342    CHARACTER(LEN=lc) :: cn_fileout = 'boundary.nc'  
    343    REAL(dp)          :: dn_dayofs  = 0._dp 
    344    LOGICAL           :: ln_extrap  = .FALSE. 
     435   CHARACTER(LEN=lc)                       :: cn_fileout = 'boundary.nc'  
     436   REAL(dp)                                :: dn_dayofs  = 0._dp 
     437   LOGICAL                                 :: ln_extrap  = .FALSE. 
    345438   !------------------------------------------------------------------- 
    346439 
     
    351444 
    352445   NAMELIST /namcfg/ &  !< config namelist 
    353    &  cn_varcfg         !< variable configuration file 
     446   &  cn_varcfg, &       !< variable configuration file 
     447   &  cn_dumcfg          !< dummy configuration file 
    354448 
    355449   NAMELIST /namcrs/ &  !< coarse grid namelist 
     
    381475 
    382476   NAMELIST /namvar/ &  !< variable namelist 
    383    &  cn_varinfo,    &  !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' ) 
    384    &  cn_varfile        !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' )  
     477   &  cn_varfile, &     !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' )  
     478   &  cn_varinfo        !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' ) 
    385479  
    386480   NAMELIST /namnst/ &  !< nesting namelist 
     
    405499   !------------------------------------------------------------------- 
    406500 
    407    ! namelist 
    408    ! get namelist 
    409    il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec 
    410    IF( il_narg/=1 )THEN 
    411       PRINT *,"CREATE BOUNDARY: ERROR. need a namelist" 
    412       STOP 
    413    ELSE 
    414       CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec 
    415    ENDIF 
    416     
    417501   ! read namelist 
    418    INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 
     502   INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist) 
     503 
    419504   IF( ll_exist )THEN 
    420505       
    421506      il_fileid=fct_getunit() 
    422507 
    423       OPEN( il_fileid, FILE=TRIM(cl_namelist), & 
     508      OPEN( il_fileid, FILE=TRIM(cd_namelist), & 
    424509      &                FORM='FORMATTED',       & 
    425510      &                ACCESS='SEQUENTIAL',    & 
     
    429514      CALL fct_err(il_status) 
    430515      IF( il_status /= 0 )THEN 
    431          PRINT *,"CREATE BOUNDARY: ERROR opening "//TRIM(cl_namelist) 
     516         PRINT *,"CREATE BOUNDARY: ERROR opening "//TRIM(cd_namelist) 
    432517         STOP 
    433518      ENDIF 
     
    441526      ! get variable extra information 
    442527      CALL var_def_extra(TRIM(cn_varcfg)) 
     528 
     529      ! get dummy variable 
     530      CALL var_get_dummy(TRIM(cn_dumcfg)) 
     531      ! get dummy dimension 
     532      CALL dim_get_dummy(TRIM(cn_dumcfg)) 
     533      ! get dummy attribute 
     534      CALL att_get_dummy(TRIM(cn_dumcfg)) 
    443535 
    444536      READ( il_fileid, NML = namcrs ) 
     
    458550      CALL fct_err(il_status) 
    459551      IF( il_status /= 0 )THEN 
    460          CALL logger_error("CREATE BOUNDARY: ERROR closing "//TRIM(cl_namelist)) 
     552         CALL logger_error("CREATE BOUNDARY: ERROR closing "//TRIM(cd_namelist)) 
    461553      ENDIF 
    462554 
    463555   ELSE 
    464556 
    465       PRINT *,"CREATE BOUNDARY: ERROR. can not find "//TRIM(cl_namelist) 
     557      PRINT *,"CREATE BOUNDARY: ERROR. can not find "//TRIM(cd_namelist) 
    466558      STOP 
    467559 
     
    525617   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN 
    526618      CALL logger_error("CREATE BOUNDARY: invalid refinement factor."//& 
    527       &  " check namelist "//TRIM(cl_namelist)) 
     619      &  " check namelist "//TRIM(cd_namelist)) 
    528620   ELSE 
    529621      il_rho(jp_I)=in_rhoi 
     
    562654   &                                ln_oneseg )  
    563655 
     656 
    564657   CALL var_clean(tl_var1) 
    565658 
    566659   ! compute level 
    567660   ALLOCATE(tl_level(ip_npoint)) 
    568    tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 
     661   tl_level(:)=vgrid_get_level(tl_bathy1, cd_namelist ) 
    569662 
    570663   ! get coordinate for each segment of each boundary 
     
    676769         !- end of use input matrix to fill variable 
    677770         ELSE 
    678          !- use file to fill variable 
     771         !- use mpp file to fill variable 
    679772 
    680773            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name) 
     
    683776            CALL grid_get_info(tl_mpp) 
    684777 
    685             ! check vertical dimension 
    686             IF( tl_mpp%t_dim(jp_K)%l_use .AND. & 
    687             &   tl_mpp%t_dim(jp_K)%i_len /= in_nlevel  )THEN 
    688                CALL logger_error("CREATE BOUNDARY: dimension in file "//& 
    689                &  TRIM(tl_mpp%c_name)//" not agree with namelist in_nlevel ") 
    690             ENDIF 
    691  
    692             ! open mpp file 
    693             CALL iom_mpp_open(tl_mpp) 
    694  
    695             ! get or check depth value 
    696             CALL create_boundary_check_depth( tl_mpp, tl_depth ) 
    697  
    698             ! get or check time value 
    699             CALL create_boundary_check_time( tl_mpp, tl_time ) 
    700  
    701             ! close mpp file 
    702             CALL iom_mpp_close(tl_mpp) 
    703  
    704             IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 
    705             &        tl_coord0%t_dim(1:2)%i_len) )THEN 
    706             !- extract value from fine grid 
    707  
    708                IF( ANY( tl_mpp%t_dim(1:2)%i_len <= & 
    709                &        tl_coord1%t_dim(1:2)%i_len) )THEN 
    710                   CALL logger_fatal("CREATE BOUNDARY: dimension in file "//& 
    711                   &  TRIM(tl_mpp%c_name)//" smaller than those in fine"//& 
    712                   &  " grid coordinates.") 
    713                ENDIF 
    714  
    715                DO jl=1,ip_ncard 
    716                   IF( tl_bdy(jl)%l_use )THEN 
    717                       
    718                      WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//& 
    719                         &  ' boundary' 
    720                      DO jk=1,tl_bdy(jl)%i_nseg 
    721                         ! compute domain on fine grid 
    722                          
    723                         ! for each variable of this file 
    724                         DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    725                             
    726                            cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name 
    727                            WRITE(*,'(4x,a,a)') "work on (extract) variable "//& 
    728                               &  TRIM(cl_name) 
    729  
    730                            cl_point=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_point 
    731                            ! open mpp file on domain 
    732                            SELECT CASE(TRIM(cl_point)) 
    733                               CASE DEFAULT !'T' 
    734                                  jpoint=jp_T 
    735                               CASE('U') 
    736                                  jpoint=jp_U 
    737                               CASE('V') 
    738                                  jpoint=jp_V 
    739                               CASE('F') 
    740                                  jpoint=jp_F 
    741                            END SELECT 
    742  
    743                            tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 
    744  
    745                            ! open mpp files 
    746                            CALL iom_dom_open(tl_mpp, tl_dom1) 
    747  
    748                            !7-5 read variable over domain 
    749                            tl_segvar1(jvar+jj,jk,jl)=iom_dom_read_var( & 
    750                            &                     tl_mpp, TRIM(cl_name), tl_dom1) 
    751  
    752                            ! del extra point 
    753                            CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
    754                            &                   tl_dom1 ) 
    755  
    756                            ! clean extra point information on fine grid domain 
    757                            CALL dom_clean_extra( tl_dom1 ) 
    758  
    759                            ! add attribute to variable 
    760                            tl_att=att_init('src_file', & 
    761                               &  TRIM(fct_basename(tl_mpp%c_name))) 
    762                            CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    763  
    764                            tl_att=att_init('src_i_indices', & 
    765                               &  (/tl_dom1%i_imin, tl_dom1%i_imax/)) 
    766                            CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    767  
    768                            tl_att=att_init('src_j_indices', & 
    769                               &  (/tl_dom1%i_jmin, tl_dom1%i_jmax/)) 
    770                            CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    771  
    772                            ! clean structure 
    773                            CALL att_clean(tl_att) 
    774                            CALL dom_clean(tl_dom1) 
    775  
    776                            ! close mpp files 
    777                            CALL iom_dom_close(tl_mpp) 
    778  
    779                            ! clean 
    780                            CALL var_clean(tl_lvl1) 
    781  
    782                         ENDDO ! jj 
    783                      ENDDO ! jk 
    784  
    785                   ENDIF 
    786                ENDDO ! jl 
    787  
    788                ! clean 
    789                CALL mpp_clean(tl_mpp) 
    790  
    791                jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    792  
    793             !- end of extract value from fine grid 
    794             ELSE 
    795             !- interpolate value from coarse grid 
    796  
    797                DO jl=1,ip_ncard 
    798                   IF( tl_bdy(jl)%l_use )THEN 
    799  
    800                      WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//& 
    801                         &  ' boundary' 
    802                      DO jk=1,tl_bdy(jl)%i_nseg 
    803                          
    804                         ! for each variable of this file 
    805                         DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
     778            DO jl=1,ip_ncard 
     779               IF( tl_bdy(jl)%l_use )THEN 
     780 
     781                  WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//& 
     782                     &  ' boundary' 
     783                  DO jk=1,tl_bdy(jl)%i_nseg 
     784 
     785                     ! for each variable of this file 
     786                     DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    806787  
    807                            WRITE(*,'(4x,a,a)') "work on (interp) variable "//& 
    808                            &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    809  
    810                            tl_var0=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 
    811                            ! open mpp file on domain 
    812                            SELECT CASE(TRIM(tl_var0%c_point)) 
    813                               CASE DEFAULT !'T' 
    814                                  jpoint=jp_T 
    815                               CASE('U') 
    816                                  jpoint=jp_U 
    817                               CASE('V') 
    818                                  jpoint=jp_V 
    819                               CASE('F') 
    820                                  jpoint=jp_F 
    821                            END SELECT 
    822  
    823                            tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 
    824  
    825                            CALL create_boundary_get_coord( tl_coord1, tl_dom1, & 
    826                            &                               tl_var0%c_point,    & 
    827                            &                               tl_lon1, tl_lat1 ) 
    828  
    829                            ! get coarse grid indices of this segment 
    830                            il_ind(:,:)=grid_get_coarse_index(tl_coord0, & 
    831                            &                                 tl_lon1, tl_lat1, & 
    832                            &                                 id_rho=il_rho(:) ) 
    833  
    834                            IF( ANY(il_ind(:,:)==0) )THEN 
    835                               CALL logger_error("CREATE BOUNDARY: error "//& 
    836                               &  "computing coarse grid indices") 
    837                            ELSE 
    838                               il_imin0=il_ind(1,1) 
    839                               il_imax0=il_ind(1,2) 
    840  
    841                               il_jmin0=il_ind(2,1) 
    842                               il_jmax0=il_ind(2,2) 
    843                            ENDIF 
    844  
    845                            il_offset(:,:)= grid_get_fine_offset( & 
    846                            &                    tl_coord0, & 
    847                            &                    il_imin0, il_jmin0,& 
    848                            &                    il_imax0, il_jmax0,& 
    849                            &                    tl_lon1%d_value(:,:,1,1),& 
    850                            &                    tl_lat1%d_value(:,:,1,1),& 
    851                            &                    il_rho(:),& 
    852                            &                    TRIM(tl_var0%c_point) ) 
    853  
    854                            ! compute coarse grid segment domain 
    855                            tl_dom0=dom_init( tl_coord0,         & 
    856                            &                 il_imin0, il_imax0,& 
    857                            &                 il_jmin0, il_jmax0 ) 
    858  
    859                            ! add extra band (if possible) to compute  
    860                            ! interpolation 
    861                            CALL dom_add_extra(tl_dom0) 
    862  
    863                            ! read variables on domain  
    864                            ! open mpp files 
    865                            CALL iom_dom_open(tl_mpp, tl_dom0) 
    866  
    867                            cl_name=tl_var0%c_name 
    868                            ! read variable value on domain 
    869                            tl_segvar1(jvar+jj,jk,jl)= & 
    870                            &    iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0) 
    871  
     788                        WRITE(*,'(4x,a,a)') "work on variable "//& 
     789                        &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
     790 
     791                        tl_var0=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 
     792 
     793                        ! open mpp file 
     794                        CALL iom_mpp_open(tl_mpp) 
     795 
     796                        ! get or check depth value 
     797                        CALL create_boundary_check_depth( tl_var0, tl_mpp, & 
     798                        &                                 in_nlevel, tl_depth ) 
     799 
     800                        ! get or check time value 
     801                        CALL create_boundary_check_time( tl_var0, tl_mpp, & 
     802                        &                                tl_time ) 
     803 
     804                        ! close mpp file 
     805                        CALL iom_mpp_close(tl_mpp) 
     806 
     807                        ! open mpp file on domain 
     808                        SELECT CASE(TRIM(tl_var0%c_point)) 
     809                           CASE DEFAULT !'T' 
     810                              jpoint=jp_T 
     811                           CASE('U') 
     812                              jpoint=jp_U 
     813                           CASE('V') 
     814                              jpoint=jp_V 
     815                           CASE('F') 
     816                              jpoint=jp_F 
     817                        END SELECT 
     818 
     819                        tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 
     820 
     821                        CALL create_boundary_get_coord( tl_coord1, tl_dom1, & 
     822                        &                               tl_var0%c_point,    & 
     823                        &                               tl_lon1, tl_lat1 ) 
     824 
     825                        ! get coarse grid indices of this segment 
     826                        il_ind(:,:)=grid_get_coarse_index(tl_coord0, & 
     827                        &                                 tl_lon1, tl_lat1, & 
     828                        &                                 id_rho=il_rho(:) ) 
     829 
     830                        IF( ANY(il_ind(:,:)==0) )THEN 
     831                           CALL logger_error("CREATE BOUNDARY: error "//& 
     832                           &  "computing coarse grid indices") 
     833                        ELSE 
     834                           il_imin0=il_ind(1,1) 
     835                           il_imax0=il_ind(1,2) 
     836 
     837                           il_jmin0=il_ind(2,1) 
     838                           il_jmax0=il_ind(2,2) 
     839                        ENDIF 
     840 
     841                        il_offset(:,:)= grid_get_fine_offset( & 
     842                        &                    tl_coord0, & 
     843                        &                    il_imin0, il_jmin0,& 
     844                        &                    il_imax0, il_jmax0,& 
     845                        &                    tl_lon1%d_value(:,:,1,1),& 
     846                        &                    tl_lat1%d_value(:,:,1,1),& 
     847                        &                    il_rho(:),& 
     848                        &                    TRIM(tl_var0%c_point) ) 
     849 
     850                        ! compute coarse grid segment domain 
     851                        tl_dom0=dom_init( tl_coord0,         & 
     852                        &                 il_imin0, il_imax0,& 
     853                        &                 il_jmin0, il_jmax0 ) 
     854 
     855                        ! add extra band (if possible) to compute interpolation 
     856                        CALL dom_add_extra(tl_dom0) 
     857 
     858                        ! open mpp files 
     859                        CALL iom_dom_open(tl_mpp, tl_dom0) 
     860 
     861                        cl_name=tl_var0%c_name 
     862                        ! read variable value on domain 
     863                        tl_segvar1(jvar+jj,jk,jl)= & 
     864                        &    iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0) 
     865 
     866                        IF( ANY(il_rho(:)/=1) )THEN 
     867                           WRITE(*,'(4x,a,a)') "interp variable "//TRIM(cl_name) 
    872868                           ! work on variable 
    873869                           CALL create_boundary_interp( & 
    874870                           &                 tl_segvar1(jvar+jj,jk,jl),& 
    875871                           &                 il_rho(:), il_offset(:,:) ) 
    876  
    877                            ! remove extraband added to domain 
    878                            CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
    879                            &                   tl_dom0, il_rho(:) ) 
    880  
    881                            ! del extra point on fine grid 
    882                            CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
    883                            &                   tl_dom1 ) 
    884                            ! clean extra point information on coarse grid domain 
    885                            CALL dom_clean_extra( tl_dom0 ) 
    886  
    887                            ! add attribute to variable 
    888                            tl_att=att_init('src_file',& 
    889                            &  TRIM(fct_basename(tl_mpp%c_name))) 
     872                        ENDIF 
     873 
     874                        ! remove extraband added to domain 
     875                        CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
     876                        &                   tl_dom0, il_rho(:) ) 
     877 
     878                        ! del extra point on fine grid 
     879                        CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
     880                        &                   tl_dom1 ) 
     881                        ! clean extra point information on coarse grid domain 
     882                        CALL dom_clean_extra( tl_dom0 ) 
     883 
     884                        ! add attribute to variable 
     885                        tl_att=att_init('src_file',& 
     886                        &  TRIM(fct_basename(tl_mpp%c_name))) 
     887                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 
     888                        &                 tl_att) 
     889 
     890                        !  
     891                        tl_att=att_init('src_i_indices',& 
     892                        &  (/tl_dom0%i_imin, tl_dom0%i_imax/)) 
     893                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 
     894                        &                 tl_att) 
     895 
     896                        tl_att=att_init('src_j_indices', & 
     897                        &  (/tl_dom0%i_jmin, tl_dom0%i_jmax/)) 
     898                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 
     899                        &                 tl_att) 
     900 
     901                        IF( ANY(il_rho(:)/=1) )THEN 
     902                           tl_att=att_init("refinment_factor", & 
     903                           &               (/il_rho(jp_I),il_rho(jp_J)/)) 
    890904                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 
    891905                           &                 tl_att) 
    892  
    893                            ! use clean extra avt creer attribut 
    894                            tl_att=att_init('src_i-indices',& 
    895                            &  (/tl_dom0%i_imin, tl_dom0%i_imax/)) 
    896                            CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 
    897                            &                 tl_att) 
    898  
    899                            tl_att=att_init('src_j-indices', & 
    900                            &  (/tl_dom0%i_jmin, tl_dom0%i_jmax/)) 
    901                            CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 
    902                            &                 tl_att) 
    903  
    904                            IF( ANY(il_rho(:)/=1) )THEN 
    905                               tl_att=att_init("refinment_factor", & 
    906                               &               (/il_rho(jp_I),il_rho(jp_J)/)) 
    907                               CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 
    908                               &                 tl_att) 
    909                            ENDIF 
    910  
    911                            ! clean structure 
    912                            CALL att_clean(tl_att) 
    913  
    914                            ! clean 
    915                            CALL dom_clean(tl_dom0) 
    916                            CALL dom_clean(tl_dom1) 
    917  
    918                            ! close mpp files 
    919                            CALL iom_dom_close(tl_mpp) 
    920  
    921                            ! clean structure 
    922                            CALL var_clean(tl_lon1) 
    923                            CALL var_clean(tl_lat1) 
    924                            CALL var_clean(tl_lvl1) 
    925  
    926                         ENDDO ! jj 
     906                        ENDIF 
     907 
     908                        ! clean structure 
     909                        CALL att_clean(tl_att) 
    927910 
    928911                        ! clean 
    929                         CALL var_clean(tl_var0) 
    930  
    931                      ENDDO ! jk 
    932                 
    933                   ENDIF 
    934                ENDDO ! jl 
    935  
    936                jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    937  
    938             !- end of interpolate value from coarse grid 
    939             ENDIF 
     912                        CALL dom_clean(tl_dom0) 
     913                        CALL dom_clean(tl_dom1) 
     914 
     915                        ! close mpp files 
     916                        CALL iom_dom_close(tl_mpp) 
     917 
     918                        ! clean structure 
     919                        CALL var_clean(tl_lon1) 
     920                        CALL var_clean(tl_lat1) 
     921                        CALL var_clean(tl_lvl1) 
     922 
     923                     ENDDO ! jj 
     924 
     925                     ! clean 
     926                     CALL var_clean(tl_var0) 
     927 
     928                  ENDDO ! jk 
     929             
     930               ENDIF 
     931            ENDDO ! jl 
     932 
     933            jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    940934 
    941935            ! clean 
     
    944938         !- end of use file to fill variable 
    945939         ENDIF 
    946       ENDDO 
     940      ENDDO ! ji 
    947941   ENDIF 
    948942 
     
    11481142   ! clean 
    11491143   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth) 
    1150    IF( ASSOCIATED(tl_time%d_value) )   CALL var_clean(tl_time) 
     1144   IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time) 
    11511145   DEALLOCATE( tl_segdom1 ) 
    11521146   DEALLOCATE( tl_segvar1 ) 
     
    11631157   CALL logger_footer() 
    11641158   CALL logger_close() 
    1165  
    1166 CONTAINS 
     1159   CALL logger_clean() 
     1160 
     1161END SUBROUTINE create__boundary 
    11671162   !------------------------------------------------------------------- 
    11681163   !> @brief 
     
    12941289      TYPE(TMPP)      , INTENT(IN   ) :: td_coord1 
    12951290      TYPE(TDOM)      , INTENT(IN   ) :: td_dom1 
     1291      CHARACTER(LEN=*), INTENT(IN   ) :: cd_point 
    12961292      TYPE(TVAR)      , INTENT(  OUT) :: td_lon1 
    12971293      TYPE(TVAR)      , INTENT(  OUT) :: td_lat1  
    1298       CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_point 
    12991294 
    13001295      ! local variable 
    1301       TYPE(TMPP)  :: tl_coord1 
     1296      TYPE(TMPP)        :: tl_coord1 
    13021297       
    13031298      CHARACTER(LEN=lc) :: cl_name 
     
    13511346      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset 
    13521347 
    1353       INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_iext 
    1354       INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_jext 
     1348      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext 
     1349      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext 
    13551350 
    13561351 
     
    14041399   !> and with dimension of the coordinate file.  
    14051400   !> Then the variable array of value is split into equal subdomain. 
    1406    !> Each subdomain is fill with the linked value of the matrix. 
     1401   !> Each subdomain is fill with the associated value of the matrix. 
    14071402   !> 
    14081403   !> @author J.Paul 
     
    14171412      IMPLICIT NONE 
    14181413      ! Argument 
    1419       TYPE(TVAR) ,               INTENT(IN) :: td_var 
    1420       TYPE(TDOM) ,               INTENT(IN) :: td_dom 
    1421       INTEGER(i4),               INTENT(IN) :: id_nlevel 
     1414      TYPE(TVAR) , INTENT(IN) :: td_var 
     1415      TYPE(TDOM) , INTENT(IN) :: td_dom 
     1416      INTEGER(i4), INTENT(IN) :: id_nlevel 
    14221417 
    14231418      ! function 
     
    16211616   !------------------------------------------------------------------- 
    16221617   !> @brief 
    1623    !> This subroutine get depth variable value in an open mpp structure 
     1618   !> This subroutine check if variable need depth dimension,  
     1619   !> get depth variable value in an open mpp structure 
    16241620   !> and check if agree with already input depth variable. 
    16251621   !>  
     
    16281624   !> @author J.Paul 
    16291625   !> @date November, 2014 - Initial Version 
     1626   !> @date January, 2016 
     1627   !> - check if variable need/use depth dimension 
    16301628   !> 
     1629   !> @param[in] td_var       variable structure 
    16311630   !> @param[in] td_mpp       mpp structure 
     1631   !> @param[in] id_nlevel    mpp structure 
    16321632   !> @param[inout] td_depth  depth variable structure  
    16331633   !------------------------------------------------------------------- 
    1634    SUBROUTINE create_boundary_check_depth( td_mpp, td_depth ) 
     1634   SUBROUTINE create_boundary_check_depth( td_var, td_mpp, id_nlevel, td_depth ) 
    16351635 
    16361636      IMPLICIT NONE 
    16371637 
    16381638      ! Argument 
     1639      TYPE(TVAR) , INTENT(IN   ) :: td_var 
    16391640      TYPE(TMPP) , INTENT(IN   ) :: td_mpp 
     1641      INTEGER(i4), INTENT(IN   ) :: id_nlevel 
    16401642      TYPE(TVAR) , INTENT(INOUT) :: td_depth 
    16411643 
     
    16461648      !---------------------------------------------------------------- 
    16471649 
    1648       ! get or check depth value 
    1649       IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN 
    1650  
    1651          il_varid=td_mpp%t_proc(1)%i_depthid 
    1652          IF( ASSOCIATED(td_depth%d_value) )THEN 
    1653  
    1654             tl_depth=iom_mpp_read_var(td_mpp, il_varid) 
    1655             IF( ANY( td_depth%d_value(:,:,:,:) /= & 
    1656             &        tl_depth%d_value(:,:,:,:) ) )THEN 
    1657  
    1658                CALL logger_fatal("CREATE BOUNDARY: depth value from "//& 
    1659                &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
    1660                &  " to those from former file(s).") 
    1661  
     1650      IF( td_var%t_dim(jp_K)%l_use .AND. & 
     1651      &   ( TRIM(td_var%c_axis) == '' .OR. & 
     1652      &     INDEX(TRIM(td_var%c_axis),'Z') /= 0 )& 
     1653      & )THEN 
     1654 
     1655         ! check vertical dimension 
     1656         IF( td_mpp%t_dim(jp_K)%l_use )THEN 
     1657            IF( td_mpp%t_dim(jp_K)%i_len /= id_nlevel .AND. & 
     1658              & td_mpp%t_dim(jp_K)%i_len /= 1 )THEN 
     1659               CALL logger_error("CREATE BOUNDARY: dimension in file "//& 
     1660               &  TRIM(td_mpp%c_name)//" not agree with namelist in_nlevel ") 
    16621661            ENDIF 
    1663             CALL var_clean(tl_depth) 
    1664  
    1665          ELSE 
    1666             td_depth=iom_mpp_read_var(td_mpp,il_varid) 
    16671662         ENDIF 
    16681663 
     1664         ! get or check depth value 
     1665         IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN 
     1666 
     1667            il_varid=td_mpp%t_proc(1)%i_depthid 
     1668            IF( ASSOCIATED(td_depth%d_value) )THEN 
     1669 
     1670               tl_depth=iom_mpp_read_var(td_mpp, il_varid) 
     1671 
     1672               IF( ANY( td_depth%d_value(:,:,:,:) /= & 
     1673               &        tl_depth%d_value(:,:,:,:) ) )THEN 
     1674 
     1675                  CALL logger_error("CREATE BOUNDARY: depth value "//& 
     1676                  &  "for variable "//TRIM(td_var%c_name)//& 
     1677                  &  "from "//TRIM(td_mpp%c_name)//" not conform "//& 
     1678                  &  " to those from former file(s).") 
     1679 
     1680               ENDIF 
     1681               CALL var_clean(tl_depth) 
     1682 
     1683            ELSE 
     1684               td_depth=iom_mpp_read_var(td_mpp,il_varid) 
     1685            ENDIF 
     1686 
     1687         ENDIF 
     1688      ELSE 
     1689         CALL logger_debug("CREATE BOUNDARY: no depth dimension use"//& 
     1690         &                 " for variable "//TRIM(td_var%c_name)) 
    16691691      ENDIF 
    16701692       
     
    16721694   !------------------------------------------------------------------- 
    16731695   !> @brief 
    1674    !> This subroutine get date and time in an open mpp structure 
     1696   !> This subroutine check if variable need time dimension,  
     1697   !> get date and time in an open mpp structure 
    16751698   !> and check if agree with date and time already read. 
    16761699   !>  
     
    16791702   !> @author J.Paul 
    16801703   !> @date November, 2014 - Initial Version 
     1704   !> @date January, 2016 
     1705   !> - check if variable need/use time dimension 
    16811706   !> 
     1707   !> @param[in] td_var       variable structure 
    16821708   !> @param[in] td_mpp      mpp structure 
    16831709   !> @param[inout] td_time  time variable structure  
    16841710   !------------------------------------------------------------------- 
    1685    SUBROUTINE create_boundary_check_time( td_mpp, td_time ) 
     1711   SUBROUTINE create_boundary_check_time( td_var, td_mpp, td_time ) 
    16861712 
    16871713      IMPLICIT NONE 
    16881714 
    16891715      ! Argument 
     1716      TYPE(TVAR), INTENT(IN   ) :: td_var 
    16901717      TYPE(TMPP), INTENT(IN   ) :: td_mpp 
    16911718      TYPE(TVAR), INTENT(INOUT) :: td_time 
     
    16991726      ! loop indices 
    17001727      !---------------------------------------------------------------- 
    1701  
    1702       ! get or check depth value 
    1703       IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 
    1704  
    1705          il_varid=td_mpp%t_proc(1)%i_timeid 
    1706          IF( ASSOCIATED(td_time%d_value) )THEN 
    1707  
    1708             tl_time=iom_mpp_read_var(td_mpp, il_varid) 
    1709  
    1710             tl_date1=var_to_date(td_time) 
    1711             tl_date2=var_to_date(tl_time) 
    1712             IF( tl_date1 - tl_date2 /= 0 )THEN 
    1713  
    1714                CALL logger_fatal("CREATE BOUNDARY: date from "//& 
    1715                &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
    1716                &  " to those from former file(s).") 
    1717  
     1728      IF( td_var%t_dim(jp_L)%l_use .AND. & 
     1729      &   ( TRIM(td_var%c_axis) == '' .OR. & 
     1730      &     INDEX(TRIM(td_var%c_axis),'T') /= 0 )& 
     1731      & )THEN 
     1732 
     1733         ! get or check depth value 
     1734         IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 
     1735 
     1736            il_varid=td_mpp%t_proc(1)%i_timeid 
     1737            IF( ASSOCIATED(td_time%d_value) )THEN 
     1738 
     1739               tl_time=iom_mpp_read_var(td_mpp, il_varid) 
     1740 
     1741               tl_date1=var_to_date(td_time) 
     1742               tl_date2=var_to_date(tl_time) 
     1743               IF( tl_date1 - tl_date2 /= 0 )THEN 
     1744 
     1745                  CALL logger_warn("CREATE BOUNDARY: date from "//& 
     1746                  &  TRIM(td_mpp%c_name)//" not conform "//& 
     1747                  &  " to those from former file(s).") 
     1748 
     1749               ENDIF 
     1750               CALL var_clean(tl_time) 
     1751 
     1752            ELSE 
     1753               td_time=iom_mpp_read_var(td_mpp,il_varid) 
    17181754            ENDIF 
    1719             CALL var_clean(tl_time) 
    1720  
    1721          ELSE 
    1722             td_time=iom_mpp_read_var(td_mpp,il_varid) 
     1755 
    17231756         ENDIF 
    17241757 
     1758      ELSE 
     1759         CALL logger_debug("CREATE BOUNDARY: no time dimension use"//& 
     1760         &                 " for variable "//TRIM(td_var%c_name)) 
    17251761      ENDIF 
    1726        
     1762 
    17271763   END SUBROUTINE create_boundary_check_time 
    17281764END PROGRAM create_boundary 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/create_coord.f90

    r5608 r6392  
    99!> @file 
    1010!> @brief  
    11 !> This program create fine grid coordinate file. 
     11!> This program creates fine grid coordinate file. 
    1212!> 
    1313!> @details 
     
    2727!>    you could find a template of the namelist in templates directory. 
    2828!> 
    29 !>    create_coord.nam comprise 6 namelists:<br/> 
     29!>    create_coord.nam contains 6 namelists:<br/> 
    3030!>       - logger namelist (namlog) 
    3131!>       - config namelist (namcfg) 
     
    3535!>       - output namelist (namout) 
    3636!>     
    37 !>    @note  
    38 !>       All namelists have to be in file create_coord.nam,  
    39 !>       however variables of those namelists are all optional. 
    40 !> 
    4137!>    * _logger namelist (namlog)_:<br/> 
    4238!>       - cn_logfile   : log filename 
     
    4844!>       - cn_varcfg : variable configuration file  
    4945!> (see ./SIREN/cfg/variable.cfg) 
     46!>       - cn_dumcfg : useless (dummy) configuration file, for useless  
     47!> dimension or variable (see ./SIREN/cfg/dummy.cfg). 
    5048!> 
    5149!>    * _coarse grid namelist (namcrs)_:<br/> 
     
    6462!>             - int = interpolation method 
    6563!>             - ext = extrapolation method 
    66 !>             - flt = filter method 
    6764!>  
    6865!>                requests must be separated by ';' .<br/> 
     
    7269!>          @ref extrap and @ref filter modules.<br/> 
    7370!> 
    74 !>          Example: 'votemper: int=linear; flt=hann(2,3); ext=dist_weight',  
    75 !>          'vosaline: int=cubic'<br/> 
     71!>          Example: 'glamt: int=linear; ext=dist_weight',  
     72!>          'e1t: int=cubic/rhoi'<br/> 
    7673!>          @note  
    7774!>             If you do not specify a method which is required,  
     
    103100!> - compute offset considering grid point 
    104101!> - add global attributes in output file 
     102!> @date September, 2015 
     103!> - manage useless (dummy) variable, attributes, and dimension 
    105104!> 
    106105!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    167166 
    168167   ! namcfg 
    169    CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg'  
     168   CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg'  
     169   CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg' 
    170170 
    171171   ! namcrs 
     
    194194 
    195195   NAMELIST /namcfg/ &  !  config namelist 
    196    &  cn_varcfg         !< variable configuration file 
     196   &  cn_varcfg, &       !< variable configuration file 
     197   &  cn_dumcfg          !< dummy configuration file 
    197198 
    198199   NAMELIST /namcrs/ &  !  coarse grid namelist 
     
    254255      CALL var_def_extra(TRIM(cn_varcfg)) 
    255256 
     257      ! get dummy variable 
     258      CALL var_get_dummy(TRIM(cn_dumcfg)) 
     259      ! get dummy dimension 
     260      CALL dim_get_dummy(TRIM(cn_dumcfg)) 
     261      ! get dummy attribute 
     262      CALL att_get_dummy(TRIM(cn_dumcfg)) 
     263 
    256264      READ( il_fileid, NML = namcrs ) 
    257265      READ( il_fileid, NML = namvar ) 
     
    354362   ENDDO 
    355363 
     364   ! clean 
     365   CALL dom_clean_extra( tl_dom ) 
     366 
    356367   ! close mpp files 
    357368   CALL iom_dom_close(tl_coord0) 
     
    388399   CALL file_add_att(tl_fileout, tl_att)    
    389400 
    390    tl_att=att_init("src_i_indices",(/in_imin0,in_imax0/)) 
     401   tl_att=att_init("src_i_indices",(/tl_dom%i_imin,tl_dom%i_imax/)) 
    391402   CALL file_add_att(tl_fileout, tl_att)    
    392    tl_att=att_init("src_j_indices",(/in_jmin0,in_jmax0/)) 
     403   tl_att=att_init("src_j_indices",(/tl_dom%i_jmin,tl_dom%i_jmax/)) 
    393404   CALL file_add_att(tl_fileout, tl_att) 
    394405   IF( .NOT. ALL(il_rho(:)==1) )THEN 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/create_restart.f90

    r5616 r6392  
    99!> @file 
    1010!> @brief  
    11 !> This program create restart file. 
     11!> This program creates restart file. 
    1212!> 
    1313!> @details 
    1414!> @section sec1 method 
    1515!> 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.  
     16!> grid file or restart file. Variables could also be manually written.<br/>  
     17!> Then they are split over new layout.  
    1818!> @note  
    1919!>    method could be different for each variable. 
     
    2828!>    you could find a template of the namelist in templates directory. 
    2929!> 
    30 !>    create_restart.nam comprise 9 namelists:<br/> 
     30!>    create_restart.nam contains 9 namelists:<br/> 
    3131!>       - logger namelist (namlog) 
    3232!>       - config namelist (namcfg) 
     
    3939!>       - output namelist (namout) 
    4040!>     
    41 !>    @note  
    42 !>       All namelists have to be in file create_restart.nam  
    43 !>       however variables of those namelists are all optional. 
    44 !> 
    4541!>    * _logger namelist (namlog)_:<br/> 
    4642!>       - cn_logfile   : log filename 
     
    5248!>       - cn_varcfg : variable configuration file 
    5349!> (see ./SIREN/cfg/variable.cfg) 
     50!>       - cn_dumcfg : useless (dummy) configuration file, for useless  
     51!> dimension or variable (see ./SIREN/cfg/dummy.cfg). 
    5452!> 
    5553!>    * _coarse grid namelist (namcrs):<br/> 
     
    8280!> 
    8381!>    * _variable namelist (namvar)_:<br/> 
    84 !>       - cn_varinfo : list of variable and extra information about request(s)  
    85 !>       to be used.<br/> 
    86 !>          each elements of *cn_varinfo* is a string character 
    87 !>          (separated by ',').<br/> 
    88 !>          it is composed of the variable name follow by ':',  
    89 !>          then request(s) to be used on this variable.<br/>  
    90 !>          request could be: 
    91 !>             - int = interpolation method 
    92 !>             - ext = extrapolation method 
    93 !>             - flt = filter method 
    94 !>             - min = minimum value 
    95 !>             - max = maximum value 
    96 !>             - unt = new units 
    97 !>             - unf = unit scale factor (linked to new units) 
    98 !> 
    99 !>             requests must be separated by ';'.<br/> 
    100 !>             order of requests does not matter.<br/> 
    101 !> 
    102 !>          informations about available method could be find in @ref interp, 
    103 !>          @ref extrap and @ref filter.<br/> 
    104 !>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight','vosaline: int=cubic' 
    105 !>          @note  
    106 !>             If you do not specify a method which is required,  
    107 !>             default one is apply. 
    108 !>       - cn_varfile : list of variable, and corresponding file<br/>  
     82!>       - cn_varfile : list of variable, and associated file<br/>  
    10983!>          *cn_varfile* is the path and filename of the file where find 
    11084!>          variable.<br/> 
     
    131105!>             - 'all:restart.dimg' 
    132106!> 
     107!>       - cn_varinfo : list of variable and extra information about request(s)  
     108!>       to be used.<br/> 
     109!>          each elements of *cn_varinfo* is a string character 
     110!>          (separated by ',').<br/> 
     111!>          it is composed of the variable name follow by ':',  
     112!>          then request(s) to be used on this variable.<br/>  
     113!>          request could be: 
     114!>             - int = interpolation method 
     115!>             - ext = extrapolation method 
     116!>             - flt = filter method 
     117!>             - min = minimum value 
     118!>             - max = maximum value 
     119!>             - unt = new units 
     120!>             - unf = unit scale factor (linked to new units) 
     121!> 
     122!>             requests must be separated by ';'.<br/> 
     123!>             order of requests does not matter.<br/> 
     124!> 
     125!>          informations about available method could be find in @ref interp, 
     126!>          @ref extrap and @ref filter.<br/> 
     127!>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight', 
     128!>                   'vosaline: int=cubic' 
     129!>          @note  
     130!>             If you do not specify a method which is required,  
     131!>             default one is apply. 
     132!> 
    133133!>    * _nesting namelist (namnst)_:<br/> 
    134134!>       - in_rhoi  : refinement factor in i-direction 
    135135!>       - in_rhoj  : refinement factor in j-direction 
    136136!>       @note  
    137 !>          coarse grid indices will be deduced from fine grid 
     137!>          coarse grid indices will be computed from fine grid 
    138138!>          coordinate file. 
    139139!> 
     
    141141!>       - cn_fileout : output file 
    142142!>       - ln_extrap : extrapolate land point or not 
    143 !>       - in_niproc : i-direction number of processor 
    144 !>       - in_njproc : j-direction numebr of processor 
     143!>       - in_niproc : number of processor in i-direction 
     144!>       - in_njproc : number of processor in j-direction 
    145145!>       - in_nproc  : total number of processor to be used 
    146146!>       - cn_type   : output format ('dimg', 'cdf') 
     
    156156!> - extrapolate all land points, and add ln_extrap in namelist. 
    157157!> - allow to change unit. 
     158!> @date September, 2015 
     159!> - manage useless (dummy) variable, attributes, and dimension 
    158160!> 
    159161!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    173175   USE iom                             ! I/O manager 
    174176   USE grid                            ! grid manager 
    175    USE vgrid                            ! vertical grid manager 
     177   USE vgrid                           ! vertical grid manager 
    176178   USE extrap                          ! extrapolation manager 
    177179   USE interp                          ! interpolation manager 
     
    183185 
    184186   IMPLICIT NONE 
    185  
    186187 
    187188   ! local variable 
     
    212213 
    213214   LOGICAL                                            :: ll_exist 
     215   LOGICAL                                            :: ll_sameGrid 
    214216 
    215217   TYPE(TDOM)                                         :: tl_dom1 
     
    242244   ! namelist variable 
    243245   ! namlog 
    244    CHARACTER(LEN=lc) :: cn_logfile = 'create_restart.log'  
    245    CHARACTER(LEN=lc) :: cn_verbosity = 'warning'  
    246    INTEGER(i4)       :: in_maxerror = 5 
     246   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_restart.log'  
     247   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning'  
     248   INTEGER(i4)                             :: in_maxerror = 5 
    247249 
    248250   ! namcfg 
    249    CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg'  
     251   CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg'  
     252   CHARACTER(LEN=lc)                       :: cn_dumcfg = 'dummy.cfg' 
    250253 
    251254   ! namcrs 
    252    CHARACTER(LEN=lc) :: cn_coord0 = ''  
    253    INTEGER(i4)       :: in_perio0 = -1 
     255   CHARACTER(LEN=lc)                       :: cn_coord0 = ''  
     256   INTEGER(i4)                             :: in_perio0 = -1 
    254257 
    255258   ! namfin 
    256    CHARACTER(LEN=lc) :: cn_coord1 = '' 
    257    CHARACTER(LEN=lc) :: cn_bathy1 = '' 
    258    INTEGER(i4)       :: in_perio1 = -1 
     259   CHARACTER(LEN=lc)                       :: cn_coord1 = '' 
     260   CHARACTER(LEN=lc)                       :: cn_bathy1 = '' 
     261   INTEGER(i4)                             :: in_perio1 = -1 
    259262 
    260263   !namzgr 
    261    REAL(dp)          :: dn_pp_to_be_computed = 0._dp 
    262    REAL(dp)          :: dn_ppsur     = -3958.951371276829_dp 
    263    REAL(dp)          :: dn_ppa0      =   103.9530096000000_dp 
    264    REAL(dp)          :: dn_ppa1      =     2.4159512690000_dp 
    265    REAL(dp)          :: dn_ppa2      =   100.7609285000000_dp 
    266    REAL(dp)          :: dn_ppkth     =    15.3510137000000_dp 
    267    REAL(dp)          :: dn_ppkth2    =    48.0298937200000_dp 
    268    REAL(dp)          :: dn_ppacr     =     7.0000000000000_dp 
    269    REAL(dp)          :: dn_ppacr2    =    13.000000000000_dp 
    270    REAL(dp)          :: dn_ppdzmin  = 6._dp 
    271    REAL(dp)          :: dn_pphmax    = 5750._dp 
    272    INTEGER(i4)       :: in_nlevel    = 75 
     264   REAL(dp)                                :: dn_pp_to_be_computed = 0._dp 
     265   REAL(dp)                                :: dn_ppsur   = -3958.951371276829_dp 
     266   REAL(dp)                                :: dn_ppa0    =   103.953009600000_dp 
     267   REAL(dp)                                :: dn_ppa1    =     2.415951269000_dp 
     268   REAL(dp)                                :: dn_ppa2    =   100.760928500000_dp 
     269   REAL(dp)                                :: dn_ppkth   =    15.351013700000_dp 
     270   REAL(dp)                                :: dn_ppkth2  =    48.029893720000_dp 
     271   REAL(dp)                                :: dn_ppacr   =     7.000000000000_dp 
     272   REAL(dp)                                :: dn_ppacr2  =    13.000000000000_dp 
     273   REAL(dp)                                :: dn_ppdzmin = 6._dp 
     274   REAL(dp)                                :: dn_pphmax  = 5750._dp 
     275   INTEGER(i4)                             :: in_nlevel  = 75 
    273276 
    274277   !namzps 
    275    REAL(dp)          :: dn_e3zps_min = 25._dp 
    276    REAL(dp)          :: dn_e3zps_rat = 0.2_dp 
     278   REAL(dp)                                :: dn_e3zps_min = 25._dp 
     279   REAL(dp)                                :: dn_e3zps_rat = 0.2_dp 
    277280 
    278281   ! namvar 
     282   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
    279283   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
    280    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 
    281284 
    282285   ! namnst 
    283    INTEGER(i4)       :: in_rhoi = 0 
    284    INTEGER(i4)       :: in_rhoj = 0 
     286   INTEGER(i4)                             :: in_rhoi = 0 
     287   INTEGER(i4)                             :: in_rhoj = 0 
    285288 
    286289   ! namout 
    287    CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc'  
    288    LOGICAL           :: ln_extrap  = .FALSE. 
    289    INTEGER(i4)       :: in_nproc   = 0 
    290    INTEGER(i4)       :: in_niproc  = 0 
    291    INTEGER(i4)       :: in_njproc  = 0 
    292    CHARACTER(LEN=lc) :: cn_type    = '' 
     290   CHARACTER(LEN=lc)                       :: cn_fileout = 'restart.nc'  
     291   LOGICAL                                 :: ln_extrap  = .FALSE. 
     292   INTEGER(i4)                             :: in_nproc   = 0 
     293   INTEGER(i4)                             :: in_niproc  = 0 
     294   INTEGER(i4)                             :: in_njproc  = 0 
     295   CHARACTER(LEN=lc)                       :: cn_type    = '' 
    293296 
    294297   !------------------------------------------------------------------- 
     
    300303 
    301304   NAMELIST /namcfg/ &  !< configuration namelist 
    302    &  cn_varcfg         !< variable configuration file 
     305   &  cn_varcfg, &      !< variable configuration file 
     306   &  cn_dumcfg         !< dummy configuration file 
    303307 
    304308   NAMELIST /namcrs/ &  !< coarse grid namelist 
     
    330334 
    331335   NAMELIST /namvar/ &  !< variable namelist 
    332    &  cn_varinfo, &     !< list of variable and interpolation method to be used. 
    333    &  cn_varfile        !< list of variable file 
     336   &  cn_varfile, &     !< list of variable file 
     337   &  cn_varinfo        !< list of variable and interpolation method to be used. 
    334338    
    335339   NAMELIST /namnst/ &  !< nesting namelist 
     
    382386      ! get variable extra information 
    383387      CALL var_def_extra(TRIM(cn_varcfg)) 
     388 
     389      ! get dummy variable 
     390      CALL var_get_dummy(TRIM(cn_dumcfg)) 
     391      ! get dummy dimension 
     392      CALL dim_get_dummy(TRIM(cn_dumcfg)) 
     393      ! get dummy attribute 
     394      CALL att_get_dummy(TRIM(cn_dumcfg)) 
    384395 
    385396      READ( il_fileid, NML = namcrs ) 
     
    509520 
    510521               jvar=jvar+1 
    511                 
     522 
    512523               WRITE(*,'(2x,a,a)') "work on variable "//& 
    513524               &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
     
    541552            CALL iom_mpp_open(tl_mpp) 
    542553 
    543  
    544554            ! get or check depth value 
    545555            CALL create_restart_check_depth( tl_mpp, tl_depth ) 
     
    551561            CALL iom_mpp_close(tl_mpp) 
    552562 
    553             IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 
    554             &        tl_coord0%t_dim(1:2)%i_len) )THEN 
     563            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) .OR.& 
     564            &   ALL(il_rho(:)==1) )THEN 
    555565            !!! extract value from fine grid  
    556566 
    557                IF( ANY( tl_mpp%t_dim(1:2)%i_len <= & 
     567               IF( ANY( tl_mpp%t_dim(1:2)%i_len < & 
    558568               &        tl_coord1%t_dim(1:2)%i_len) )THEN 
    559                   CALL logger_fatal("CREATE RESTART: dimension in file "//& 
     569                  CALL logger_fatal("CREATE RESTART: dimensions in file "//& 
    560570                  &  TRIM(tl_mpp%c_name)//" smaller than those in fine"//& 
    561571                  &  " grid coordinates.") 
    562572               ENDIF 
    563573 
     574               ! use coord0 instead of mpp for restart file case  
     575               !  (without lon,lat) 
     576               ll_sameGrid=.FALSE. 
     577               IF( ALL(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) & 
     578               &   )THEN 
     579                  ll_sameGrid=.TRUE.  
     580               ENDIF 
     581 
    564582               ! compute domain on fine grid 
    565                il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 ) 
     583               IF( ll_sameGrid )THEN 
     584                  il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 ) 
     585               ELSE 
     586                  il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1 ) 
     587               ENDIF 
    566588 
    567589               il_imin1=il_ind(1,1) ; il_imax1=il_ind(1,2) 
     
    569591 
    570592               !- check grid coincidence 
    571                CALL grid_check_coincidence( tl_mpp, tl_coord1, & 
    572                &                            il_imin1, il_imax1, & 
    573                &                            il_jmin1, il_jmax1, & 
    574                &                            il_rho(:) ) 
     593               IF( ll_sameGrid )THEN 
     594                  CALL grid_check_coincidence( tl_mpp, tl_coord1, & 
     595                  &                            il_imin1, il_imax1, & 
     596                  &                            il_jmin1, il_jmax1, & 
     597                  &                            il_rho(:) ) 
     598               ELSE 
     599                  CALL grid_check_coincidence( tl_coord0, tl_coord1, & 
     600                  &                            il_imin1, il_imax1, & 
     601                  &                            il_jmin1, il_jmax1, & 
     602                  &                            il_rho(:) ) 
     603               ENDIF 
    575604 
    576605               ! compute domain 
     
    754783 
    755784   DO ji=1,ip_maxdim 
     785 
    756786      IF( tl_dim(ji)%l_use )THEN 
    757787         CALL mpp_move_dim(tl_mppout, tl_dim(ji)) 
     
    763793         END SELECT  
    764794      ENDIF 
     795 
    765796   ENDDO 
    766797 
     
    879910   !> and with dimension of the coordinate file.<br/>  
    880911   !> Then the variable array of value is split into equal subdomain. 
    881    !> Each subdomain is filled with the corresponding value of the matrix. 
     912   !> Each subdomain is filled with the associated value of the matrix. 
    882913   !> 
    883914   !> @author J.Paul 
     
    11691200            &        tl_depth%d_value(:,:,:,:) ) )THEN 
    11701201 
    1171                CALL logger_fatal("CREATE BOUNDARY: depth value from "//& 
    1172                &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
     1202               CALL logger_warn("CREATE BOUNDARY: depth value from "//& 
     1203               &  TRIM(td_mpp%c_name)//" not conform "//& 
    11731204               &  " to those from former file(s).") 
    11741205 
     
    12261257            IF( tl_date1 - tl_date2 /= 0 )THEN 
    12271258 
    1228                CALL logger_fatal("CREATE BOUNDARY: date from "//& 
    1229                &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 
     1259               CALL logger_warn("CREATE BOUNDARY: date from "//& 
     1260               &  TRIM(td_mpp%c_name)//" not conform "//& 
    12301261               &  " to those from former file(s).") 
    12311262 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/dimension.f90

    r5616 r6392  
    154154! REVISION HISTORY: 
    155155!> @date November, 2013 - Initial Version 
     156!> @date Spetember, 2015 
     157!> - manage useless (dummy) dimension 
    156158!> 
    157159!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    167169   ! type and variable 
    168170   PUBLIC :: TDIM              !< dimension structure 
     171 
     172   PRIVATE :: cm_dumdim        !< dummy dimension array 
    169173 
    170174   ! function and subroutine 
     
    182186   PUBLIC :: dim_get_index     !< get dimension index in array of dimension structure 
    183187   PUBLIC :: dim_get_id        !< get dimension id in array of dimension structure 
     188   PUBLIC :: dim_get_dummy     !< fill dummy dimension array 
     189   PUBLIC :: dim_is_dummy      !< check if dimension is defined as dummy dimension 
    184190 
    185191   PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t') 
     
    209215   END TYPE 
    210216 
     217   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumdim !< dummy dimension 
     218 
    211219   INTERFACE dim_print 
    212220      MODULE PROCEDURE dim__print_unit ! print information on one dimension 
     
    518526   !> @param[in] ld_uld    dimension unlimited 
    519527   !> @param[in] cd_sname  dimension short name 
    520    !> @param[in] ld_uld    dimension use or not 
     528   !> @param[in] ld_use    dimension use or not 
    521529   !> @return dimension structure 
    522530   !------------------------------------------------------------------- 
    523    TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use) 
     531   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use ) 
    524532      IMPLICIT NONE 
    525533 
     
    14011409 
    14021410   END SUBROUTINE dim__clean_arr 
     1411   !------------------------------------------------------------------- 
     1412   !> @brief This subroutine fill dummy dimension array 
     1413   ! 
     1414   !> @author J.Paul 
     1415   !> @date September, 2015 - Initial Version 
     1416   ! 
     1417   !> @param[in] cd_dummy dummy configuration file 
     1418   !------------------------------------------------------------------- 
     1419   SUBROUTINE dim_get_dummy( cd_dummy ) 
     1420      IMPLICIT NONE 
     1421      ! Argument 
     1422      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy 
     1423 
     1424      ! local variable 
     1425      INTEGER(i4)   :: il_fileid 
     1426      INTEGER(i4)   :: il_status 
     1427 
     1428      LOGICAL       :: ll_exist 
     1429 
     1430      ! loop indices 
     1431      ! namelist 
     1432      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar 
     1433      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim 
     1434      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt 
     1435 
     1436      !---------------------------------------------------------------- 
     1437      NAMELIST /namdum/ &   !< dummy namelist 
     1438      &  cn_dumvar, &       !< variable  name 
     1439      &  cn_dumdim, &       !< dimension name 
     1440      &  cn_dumatt          !< attribute name 
     1441      !---------------------------------------------------------------- 
     1442 
     1443      ! init 
     1444      cm_dumdim(:)='' 
     1445 
     1446      ! read namelist 
     1447      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 
     1448      IF( ll_exist )THEN 
     1449 
     1450         il_fileid=fct_getunit() 
     1451 
     1452         OPEN( il_fileid, FILE=TRIM(cd_dummy), & 
     1453         &                FORM='FORMATTED',       & 
     1454         &                ACCESS='SEQUENTIAL',    & 
     1455         &                STATUS='OLD',           & 
     1456         &                ACTION='READ',          & 
     1457         &                IOSTAT=il_status) 
     1458         CALL fct_err(il_status) 
     1459         IF( il_status /= 0 )THEN 
     1460            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 
     1461         ENDIF 
     1462 
     1463         READ( il_fileid, NML = namdum ) 
     1464         cm_dumdim(:)=cn_dumdim(:) 
     1465 
     1466         CLOSE( il_fileid ) 
     1467 
     1468      ENDIF 
     1469 
     1470   END SUBROUTINE dim_get_dummy 
     1471   !------------------------------------------------------------------- 
     1472   !> @brief This function check if dimension is defined as dummy dimension 
     1473   !> in configuraton file 
     1474   !> 
     1475   !> @author J.Paul 
     1476   !> @date September, 2015 - Initial Version 
     1477   ! 
     1478   !> @param[in] td_dim dimension structure 
     1479   !> @return true if dimension is dummy dimension  
     1480   !------------------------------------------------------------------- 
     1481   FUNCTION dim_is_dummy(td_dim) 
     1482      IMPLICIT NONE 
     1483 
     1484      ! Argument       
     1485      TYPE(TDIM), INTENT(IN) :: td_dim 
     1486       
     1487      ! function 
     1488      LOGICAL :: dim_is_dummy 
     1489       
     1490      ! loop indices 
     1491      INTEGER(i4) :: ji 
     1492      !---------------------------------------------------------------- 
     1493 
     1494      dim_is_dummy=.FALSE. 
     1495      DO ji=1,ip_maxdum 
     1496         IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN 
     1497            dim_is_dummy=.TRUE. 
     1498            EXIT 
     1499         ENDIF 
     1500      ENDDO 
     1501 
     1502   END FUNCTION dim_is_dummy 
    14031503END MODULE dim 
    14041504 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md

    r5616 r6392  
    1 # How to Install 
     1# Download 
    22 
    3 # Install NEMO 
    4 to install SIREN, you should first install NEMO. 
    5 see [here](http://www.nemo-ocean.eu/Using-NEMO/User-Guides/Basics/NEMO-Quick-Start-Guide) 
     3# Download NEMO # 
     4to install SIREN, you should first download NEMO. 
     5see [NEMO quick start guide](http://www.nemo-ocean.eu/Using-NEMO/User-Guides/Basics/NEMO-Quick-Start-Guide) 
    66 
    7 # Compile SIREN 
     7# Compile SIREN # 
    88when NEMO is installed, you just have to compile SIREN codes: 
    9 1. go to ./NEMOGCM/TOOLS 
    10 2. use maketools <br/> 
    11    to get help: maketools -h  
     9   1. go to ./NEMOGCM/TOOLS 
     10   2. run maketools (ex: ./maketools -n SIREN -m ifort_mpi_beaufix) 
    1211 
    13 # Fortran Compiler 
    14    SIREN codes were succesfully tested with : 
    15    - ifort (version 15.0.1) 
    16    - gfortran (version 4.8.2 20140120)  
    17 <!--   - pgf95 (version 13.9-0) --> 
     12      @note to get help on maketools: ./maketools -h 
    1813 
    19  <HR> 
    20    <b> 
    21    - @ref index 
    22    - @ref md_docsrc_3_codingRules 
    23    - @ref md_docsrc_4_changeLog 
    24    - @ref todo 
    25    </b> 
     14# Fortran Compiler # 
     15SIREN codes were succesfully tested with : 
     16  - ifort (version 15.0.1) 
     17  - gfortran (version 4.8.2 20140120)  
     18 
     19<HR> 
     20  <b> 
     21  - @ref index 
     22  - @ref md_docsrc_2_quickstart 
     23  - @ref md_docsrc_3_support_bug 
     24  - @ref md_docsrc_4_codingRules 
     25  - @ref md_docsrc_5_changeLog 
     26  - @ref todo 
     27  </b> 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/docsrc/4_codingRules.md

    r6391 r6392  
    9494   - @ref index 
    9595   - @ref md_docsrc_1_install 
    96    - @ref md_docsrc_4_changeLog 
     96   - @ref md_docsrc_2_quickstart 
     97   - @ref md_docsrc_3_support_bug 
     98   - @ref md_docsrc_5_changeLog 
    9799   - @ref todo 
    98100   </b> 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/docsrc/5_changeLog.md

    r6391 r6392  
    33@tableofcontents 
    44 
    5 # Release 3.6 
    6 Initial release (release date ) 
     5# Release $Revision$ 
     6Initial release (2016-03-17) 
    77 
    88## Changes 
     
    1414   - @ref index 
    1515   - @ref md_docsrc_1_install 
    16    - @ref md_docsrc_3_codingRules 
     16   - @ref md_docsrc_2_quickstart 
     17   - @ref md_docsrc_3_support_bug 
     18   - @ref md_docsrc_4_codingRules 
    1719   - @ref todo 
    1820   </b> 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/docsrc/main.dox

    r5037 r6392  
    11/*! 
    2  @mainpage Main Page 
    3  @section descr Generic Description 
    4  SIREN is a software to create regional configuration with 
    5  [NEMO](http://www.nemo-ocean.eu).<br/>  
     2 @mainpage About  
     3 
     4 SIREN is a software to create regional configuration with [NEMO](http://www.nemo-ocean.eu).<br/>  
    65 Actually SIREN create input files needed for a basic NEMO configuration.<br/> 
     6 
     7 SIREN allows you to create your own regional configuration embedded in a wider one.<br/> 
     8 In order to help you, a set of GLORYS files (global reanalysis on ORCA025 grid), as well as examples 
     9 of namelists are available in dods repository. 
     10 
     11 @note This software was created, and is maintain by the Configuration Manager Working Group, composed 
     12 of NEMO system team members. 
    713  
    8  SIREN is composed of a set of 5 Fortran programs : 
    9    - create_coord.f90 to create fine grid coordinate file from coarse grid coordinate file. 
    10    - create_bathy.f90 to create fine grid bathymetry file over domain. 
    11    - merge_bathy.f90 to merge fine grid bathymetry with coarse grid bathymetry at boundaries. 
    12    - create_restart.f90 to create initial state file from coarse grid restart or standard outputs. 
    13    - create_boundary.f90 to create boundary condition from coarse grid standard outputs. 
     14 To know how to install SIREN see @ref md_docsrc_1_install. 
    1415 
    15 To install those programs see @ref md_docsrc_1_install. 
    16  
    17  @note SIREN can not: 
    18  - create global configuration 
    19  - create configuarion around or close to north pole 
    20  - change number of vertical level 
    21  - change grid (horizontal or vertical) 
    22  
    23  @section howto How to use 
    24    @subsection howto_coord to create fine grid coordinate file 
    25    see create_coord.f90 
    26    @subsection howto_bathy to create fine grid bathymetry 
    27    see create_bathy.f90 
    28    @subsection howto_merge to merge fine grid bathymetry 
    29    see merge_bathy.f90 
    30    @subsection howto_restart to create initial state file 
    31    see create_restart.f90 
    32    @subsection howto_boundary to create boundary condition 
    33    see create_boundary.f90 
     16 You could find a tutorial for a quick start with SIREN in @ref md_docsrc_2_quickstart.<br/> 
     17 For more information about how to use each component of SIREN 
     18 - see create_coord.f90 to create fine grid coordinate file 
     19 - see create_bathy.f90 to create fine grid bathymetry 
     20 - see merge_bathy.f90 to merge fine grid bathymetry 
     21 - see create_restart.f90 to create initial state file, or other fields. 
     22 - see create_boundary.F90 to create boundary condition 
    3423 
    3524<HR> 
    3625   <b> 
    3726   - @ref md_docsrc_1_install 
    38    - @ref md_docsrc_3_codingRules 
    39    - @ref md_docsrc_4_changeLog 
     27   - @ref md_docsrc_2_quickstart 
     28   - @ref md_docsrc_3_support_bug 
     29   - @ref md_docsrc_4_codingRules 
     30   - @ref md_docsrc_5_changeLog 
    4031   - @ref todo 
    4132   </b> 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/domain.f90

    r5616 r6392  
    12971297   !> @date September, 2014 
    12981298   !> - take into account number of ghost cell 
     1299   !> @date February, 2016 
     1300   !> - number of extra point is the MAX (not the MIN) of zero and asess value.  
    12991301   ! 
    13001302   !> @param[inout] td_dom domain strcuture 
     
    13441346                  td_dom%i_imin      = td_dom%i_imin - td_dom%i_iextra(1) 
    13451347               ELSE ! td_dom%i_imin - il_iext <= td_dom%i_ghost0(jp_I,1)*ip_ghost 
    1346                   td_dom%i_iextra(1) = MIN(0, & 
     1348                  td_dom%i_iextra(1) = MAX(0, & 
    13471349                  &                         td_dom%i_imin - & 
    13481350                  &                         td_dom%i_ghost0(jp_I,1)*ip_ghost -1) 
     
    13561358               ELSE ! td_dom%i_imax + il_iext >= & 
    13571359                    !  td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost 
    1358                   td_dom%i_iextra(2) = MIN(0, & 
     1360                  td_dom%i_iextra(2) = MAX( 0, & 
    13591361                  &                         td_dom%t_dim0(1)%i_len - & 
    13601362                  &                         td_dom%i_ghost0(jp_I,2)*ip_ghost - & 
     
    13641366 
    13651367            ELSE ! td_dom%i_ew0 >= 0 
     1368 
    13661369               ! EW cyclic 
    13671370               IF( td_dom%i_imin - il_iext > 0 )THEN 
     
    13911394            ! nothing to be done 
    13921395         ELSE 
     1396 
    13931397            IF( td_dom%i_jmin - il_jext > td_dom%i_ghost0(jp_J,1)*ip_ghost )THEN 
    13941398               td_dom%i_jextra(1) = il_jext 
    13951399               td_dom%i_jmin      = td_dom%i_jmin - td_dom%i_jextra(1) 
    13961400            ELSE ! td_dom%i_jmin - il_jext <= td_dom%i_ghost0(jp_J,1)*ip_ghost 
    1397                td_dom%i_jextra(1) = MIN(0, & 
     1401               td_dom%i_jextra(1) = MAX( 0, & 
    13981402               &                         td_dom%i_jmin - & 
    13991403               &                         td_dom%i_ghost0(jp_J,1)*ip_ghost - 1) 
     
    14071411            ELSE ! td_dom%i_jmax + il_jext >= & 
    14081412                 !  td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost 
    1409                td_dom%i_jextra(2) = MIN(0, & 
     1413               td_dom%i_jextra(2) = MAX( 0, & 
    14101414               &                         td_dom%t_dim0(2)%i_len - & 
    14111415               &                         td_dom%i_ghost0(jp_J,2)*ip_ghost - & 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/file.f90

    r5616 r6392  
    694694   !> @date November, 2013 - Initial Version 
    695695   !> @date September, 2014 
    696    !> - add dimension to file if need be 
     696   !> - add dimension in file if need be 
    697697   !> - do not reorder dimension from variable, before put in file 
     698   !> @date September, 2015 
     699   !> - check variable dimension expected 
    698700   ! 
    699701   !> @param[inout] td_file   file structure 
     
    705707      ! Argument       
    706708      TYPE(TFILE), INTENT(INOUT) :: td_file 
    707       TYPE(TVAR) , INTENT(IN   ) :: td_var 
     709      TYPE(TVAR) , INTENT(INOUT) :: td_var 
    708710 
    709711      ! local variable 
     
    761763               IF( file_check_var_dim(td_file, td_var) )THEN 
    762764 
     765                  ! check variable dimension expected 
     766                  CALL var_check_dim(td_var) 
     767 
    763768                  ! update dimension if need be 
    764769                  DO ji=1,ip_maxdim 
     
    10501055                  ! new number of variable in file 
    10511056                  td_file%i_nvar=td_file%i_nvar-1 
    1052  
    10531057                  SELECT CASE(td_var%i_ndim) 
    10541058                     CASE(0) 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/function.f90

    r5608 r6392  
    363363      IF( id_status /= 0 )THEN 
    364364         !CALL ERRSNS() ! not F95 standard 
    365          PRINT *, "FORTRAN ERROR" 
     365         PRINT *, "FORTRAN ERROR ",id_status 
    366366         !STOP 
    367367      ENDIF 
     
    740740   ! 
    741741   !> @param[in] cd_var character 
    742    !> @return character is numeric 
     742   !> @return character is real number 
    743743   !------------------------------------------------------------------- 
    744744   PURE LOGICAL FUNCTION fct_is_real(cd_var) 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/global.f90

    r5037 r6392  
    1212! REVISION HISTORY: 
    1313!> @date November, 2013 - Initial Version 
     14!> @date September, 2015 
     15!> - define fill value for each variable type 
    1416! 
    1517!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    9597   &     'gauss      '/) 
    9698 
    97    REAL(dp)                                , PARAMETER :: dp_fill=NF90_FILL_DOUBLE !< default fill value 
     99   REAL(dp)                                , PARAMETER :: dp_fill_i1=NF90_FILL_BYTE   !< byte fill value 
     100   REAL(dp)                                , PARAMETER :: dp_fill_i2=NF90_FILL_SHORT  !< short fill value 
     101   REAL(dp)                                , PARAMETER :: dp_fill_i4=NF90_FILL_INT    !< INT fill value 
     102   REAL(dp)                                , PARAMETER :: dp_fill_sp=NF90_FILL_FLOAT  !< real fill value 
     103   REAL(dp)                                , PARAMETER :: dp_fill=NF90_FILL_DOUBLE !< double fill value 
    98104 
    99105   INTEGER(i4)                             , PARAMETER :: ip_npoint=4 
     
    125131   INTEGER(i4), PARAMETER :: jp_west =4 
    126132 
    127  
     133   INTEGER(i4)                             , PARAMETER :: ip_maxdum = 10 !< maximum dummy variable, dimension, attribute 
    128134 
    129135END MODULE global 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/grid.f90

    r5616 r6392  
    8080!> point:<br/> 
    8181!> @code 
    82 !>    il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1) 
     82!>    il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1 
     83!>                                 [,dd_fill] [,cd_pos]) 
    8384!> @endcode 
    8485!>       - il_index(:) is  coarse grid indices (/ i0, j0 /) 
     
    8788!>       - dd_lon1 is fine grid longitude value (real(8)) 
    8889!>       - dd_lat1 is fine grid latitude  value (real(8)) 
     90!>       - dd_fill 
     91!>       - cd_pos 
    8992!> 
    9093!>    to compute distance between a point A and grid points:<br/> 
     
    215218!> @date February, 2015 
    216219!> - add function grid_fill_small_msk to fill small domain inside bigger one 
     220!> @February, 2016 
     221!> - improve way to check coincidence (bug fix) 
     222!> - manage grid cases for T,U,V or F point, with even or odd refinment (bug fix) 
    217223! 
    218224!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    664670             
    665671            ! no pivot point found 
    666             CALL logger_error("GRID GET PIVOT: something wrong "//& 
     672            CALL logger_warn("GRID GET PIVOT: something wrong "//& 
    667673            &  "when computing pivot point with variable "//& 
    668674            &  TRIM(td_var%c_name)) 
     
    685691 
    686692               IF( grid__get_pivot_var /= -1 )THEN 
    687                   CALL logger_warn("GRID GET PIVOT: variable "//& 
     693                  CALL logger_info("GRID GET PIVOT: variable "//& 
    688694                  &  TRIM(td_var%c_name)//" seems to be on grid point "//& 
    689695                  &  TRIM(cp_grid_point(jj)) ) 
     
    13351341         il_dim(:)=td_var%t_dim(:)%i_len 
    13361342 
    1337          CALL logger_info("GRID GET PERIO: use varibale "//TRIM(td_var%c_name)) 
    1338          CALL logger_info("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill))) 
    1339          CALL logger_info("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_value(1,1,1,1)))) 
     1343         CALL logger_debug("GRID GET PERIO: use varibale "//TRIM(td_var%c_name)) 
     1344         CALL logger_debug("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill))) 
     1345         CALL logger_debug("GRID GET PERIO: first value "//TRIM(fct_str(td_var%d_value(1,1,1,1)))) 
    13401346 
    13411347         IF(ALL(td_var%d_value(    1    ,    :    ,1,1)/=td_var%d_fill).AND.& 
     
    13441350         &  ALL(td_var%d_value(    :    ,il_dim(2),1,1)/=td_var%d_fill))THEN 
    13451351         ! no boundary closed 
    1346             CALL logger_warn("GRID GET PERIO: can't determined periodicity. "//& 
     1352            CALL logger_error("GRID GET PERIO: can't determined periodicity. "//& 
    13471353            &             "there is no boundary closed for variable "//& 
    13481354            &              TRIM(td_var%c_name) ) 
     1355            ! check pivot 
     1356            SELECT CASE(id_pivot) 
     1357               CASE(0) 
     1358                  ! F pivot 
     1359                  CALL logger_warn("GRID GET PERIO: assume domain is global") 
     1360                  grid__get_perio_var=6 
     1361               CASE(1) 
     1362                  ! T pivot 
     1363                  CALL logger_warn("GRID GET PERIO: assume domain is global") 
     1364                  grid__get_perio_var=4 
     1365            END SELECT 
    13491366         ELSE 
    13501367            ! check periodicity 
     
    22872304         &                                                    il_rho(:), cl_point ) 
    22882305 
    2289           
    22902306         CALL var_clean(tl_lon1) 
    22912307         CALL var_clean(tl_lat1)          
     
    24632479   !> - check grid point 
    24642480   !> - take into account EW overlap 
     2481   !> @date February, 2016 
     2482   !> - use delta (lon or lat) 
     2483   !> - manage cases for T,U,V or F point, with even or odd refinment 
    24652484   !> 
    24662485   !> @param[in] td_lon0   coarse grid longitude 
     
    24902509 
    24912510      ! local variable 
    2492       REAL(dp)    :: dl_lon1_ll 
    2493       REAL(dp)    :: dl_lon1_ul 
    2494       REAL(dp)    :: dl_lon1_lr 
    2495       REAL(dp)    :: dl_lon1_ur 
    2496  
    2497       REAL(dp)    :: dl_lat1_ll 
    2498       REAL(dp)    :: dl_lat1_ul 
    2499       REAL(dp)    :: dl_lat1_lr 
    2500       REAL(dp)    :: dl_lat1_ur 
     2511      CHARACTER(LEN= 1)                      :: cl_point0 
     2512      CHARACTER(LEN= 1)                      :: cl_point1 
     2513 
     2514      LOGICAL    , DIMENSION(2)              :: ll_even 
     2515 
     2516      REAL(dp)                               :: dl_lon1 
     2517      REAL(dp)                               :: dl_dlon 
     2518      REAL(dp)                               :: dl_lat1 
     2519      REAL(dp)                               :: dl_dlat 
     2520 
     2521      INTEGER(i4)                            :: il_ew0  
     2522      INTEGER(i4)                            :: il_imin0 
     2523      INTEGER(i4)                            :: il_imax0 
     2524      INTEGER(i4)                            :: il_jmin0 
     2525      INTEGER(i4)                            :: il_jmax0 
     2526 
     2527      INTEGER(i4)                            :: il_ew1  
     2528      INTEGER(i4)                            :: il_imin1 
     2529      INTEGER(i4)                            :: il_imax1 
     2530      INTEGER(i4)                            :: il_jmin1 
     2531      INTEGER(i4)                            :: il_jmax1 
     2532 
     2533      INTEGER(i4)                            :: il_imin 
     2534      INTEGER(i4)                            :: il_imax 
     2535      INTEGER(i4)                            :: il_jmin 
     2536      INTEGER(i4)                            :: il_jmax       
    25012537 
    25022538      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    25032539 
    2504       INTEGER(i4), DIMENSION(2) :: il_ill 
    2505       INTEGER(i4), DIMENSION(2) :: il_ilr 
    2506       INTEGER(i4), DIMENSION(2) :: il_iul 
    2507       INTEGER(i4), DIMENSION(2) :: il_iur 
    2508  
    2509       INTEGER(i4) :: il_ew0  
    2510       INTEGER(i4) :: il_imin0 
    2511       INTEGER(i4) :: il_imax0 
    2512       INTEGER(i4) :: il_jmin0 
    2513       INTEGER(i4) :: il_jmax0 
    2514  
    2515       INTEGER(i4) :: il_ew1  
    2516       INTEGER(i4) :: il_imin1 
    2517       INTEGER(i4) :: il_imax1 
    2518       INTEGER(i4) :: il_jmin1 
    2519       INTEGER(i4) :: il_jmax1 
    2520  
    2521       INTEGER(i4) :: il_imin 
    2522       INTEGER(i4) :: il_imax 
    2523       INTEGER(i4) :: il_jmin 
    2524       INTEGER(i4) :: il_jmax       
    2525  
    2526       INTEGER(i4), DIMENSION(2,2) :: il_xghost0 
    2527       INTEGER(i4), DIMENSION(2,2) :: il_yghost0 
    2528       INTEGER(i4), DIMENSION(2,2) :: il_xghost1 
    2529       INTEGER(i4), DIMENSION(2,2) :: il_yghost1 
    2530  
    2531       TYPE(TVAR) :: tl_lon0 
    2532       TYPE(TVAR) :: tl_lat0 
    2533       TYPE(TVAR) :: tl_lon1 
    2534       TYPE(TVAR) :: tl_lat1 
    2535  
    2536       CHARACTER(LEN= 1) :: cl_point0 
    2537       CHARACTER(LEN= 1) :: cl_point1 
    2538        
     2540      INTEGER(i4), DIMENSION(2)              :: il_ill 
     2541      INTEGER(i4), DIMENSION(2)              :: il_ilr 
     2542      INTEGER(i4), DIMENSION(2)              :: il_iul 
     2543      INTEGER(i4), DIMENSION(2)              :: il_iur 
     2544 
     2545      INTEGER(i4), DIMENSION(2,2)            :: il_xghost0 
     2546      INTEGER(i4), DIMENSION(2,2)            :: il_yghost0 
     2547      INTEGER(i4), DIMENSION(2,2)            :: il_xghost1 
     2548      INTEGER(i4), DIMENSION(2,2)            :: il_yghost1 
     2549 
     2550      TYPE(TVAR)                             :: tl_lon0 
     2551      TYPE(TVAR)                             :: tl_lat0 
     2552      TYPE(TVAR)                             :: tl_lon1 
     2553      TYPE(TVAR)                             :: tl_lat1 
     2554 
    25392555      ! loop indices 
    2540       INTEGER(i4) :: ji 
    2541       INTEGER(i4) :: jj 
    25422556      !---------------------------------------------------------------- 
    25432557      ! init 
     
    25472561      il_rho(:)=1 
    25482562      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 
     2563 
     2564      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /) 
    25492565 
    25502566      cl_point0='T' 
     
    26452661            ! get indices for each corner 
    26462662            !1- search lower left corner indices 
    2647             dl_lon1_ll=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 ) 
    2648             dl_lat1_ll=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 ) 
    2649  
    2650             IF( dl_lon1_ll == tl_lon1%d_fill .OR. & 
    2651             &   dl_lat1_ll == tl_lat1%d_fill )THEN 
    2652                CALL logger_debug("GRID GET COARSE INDEX: lon "//& 
    2653                &  TRIM(fct_str(dl_lon1_ll))//" "//& 
    2654                &  TRIM(fct_str(tl_lon1%d_fill)) ) 
    2655                CALL logger_debug("GRID GET COARSE INDEX: lat "//& 
    2656                &  TRIM(fct_str(dl_lat1_ll))//" "//& 
    2657                &  TRIM(fct_str(tl_lat1%d_fill)) ) 
     2663            dl_lon1=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 ) 
     2664            dl_lat1=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 ) 
     2665 
     2666            IF( dl_lon1 == tl_lon1%d_fill .OR. & 
     2667            &   dl_lat1 == tl_lat1%d_fill )THEN 
    26582668               CALL logger_error("GRID GET COARSE INDEX: lower left corner "//& 
    26592669               &                 "point is FillValue. remove ghost cell "//& 
    26602670               &                 "before running grid_get_coarse_index.") 
    26612671            ENDIF 
     2672 
     2673            !!!!! i-direction !!!!! 
     2674            IF( ll_even(jp_I) )THEN 
     2675               ! even 
     2676               SELECT CASE(TRIM(cl_point1)) 
     2677                  CASE('F','U') 
     2678                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   & 
     2679                        &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / & 
     2680                        &     2. 
     2681                  CASE DEFAULT 
     2682                     dl_dlon=0 
     2683               END SELECT 
     2684            ELSE 
     2685               ! odd 
     2686               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   & 
     2687                  &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / & 
     2688                  &     2. 
     2689            ENDIF 
     2690 
     2691            !!!!! j-direction !!!!! 
     2692            IF( ll_even(jp_J) )THEN 
     2693               ! even 
     2694               SELECT CASE(TRIM(cl_point1)) 
     2695                  CASE('F','V') 
     2696                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   & 
     2697                        &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / & 
     2698                        &     2. 
     2699                  CASE DEFAULT 
     2700                     dl_dlat=0 
     2701               END SELECT 
     2702            ELSE 
     2703               ! odd 
     2704               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   & 
     2705                  &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / & 
     2706                  &     2. 
     2707            ENDIF 
     2708 
     2709            dl_lon1 = dl_lon1 + dl_dlon 
     2710            dl_lat1 = dl_lat1 + dl_dlat 
     2711 
    26622712            ! look for closest point on coarse grid 
    26632713            il_ill(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
     
    26672717            &                                           il_jmin0:il_jmax0, & 
    26682718            &                                           1,1), & 
    2669             &                           dl_lon1_ll, dl_lat1_ll   ) 
    2670  
    2671             ! coarse grid point should be south west of fine grid domain 
    2672             ji = il_ill(1) 
    2673             jj = il_ill(2) 
    2674  
    2675             IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ll) > dp_delta )THEN 
    2676                IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ll )THEN 
    2677                   il_ill(1)=il_ill(1)-1 
    2678                   IF( il_ill(1) <= 0 )THEN 
    2679                      IF( tl_lon0%i_ew >= 0 )THEN 
    2680                         il_ill(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew 
    2681                      ELSE 
    2682                         CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2683                         &                 "computing lower left corner "//& 
    2684                         &                 "index for longitude") 
    2685                      ENDIF 
    2686                   ENDIF 
    2687                ENDIF 
    2688             ENDIF 
    2689             IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ll) > dp_delta )THEN 
    2690                IF(tl_lat0%d_value(ji,jj,1,1) > dl_lat1_ll )THEN 
    2691                   il_ill(2)=il_ill(2)-1 
    2692                   IF( il_ill(2)-1 <= 0 )THEN 
    2693                      CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2694                      &                 "computing lower left corner "//& 
    2695                      &                 "index for latitude") 
    2696                   ENDIF 
    2697                ENDIF 
    2698             ENDIF 
     2719            &                           dl_lon1, dl_lat1, 'll'   ) 
     2720 
    26992721 
    27002722            !2- search upper left corner indices 
    2701             dl_lon1_ul=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 ) 
    2702             dl_lat1_ul=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 ) 
    2703  
    2704             IF( dl_lon1_ul == tl_lon1%d_fill .OR. & 
    2705             &   dl_lat1_ul == tl_lat1%d_fill )THEN 
     2723            dl_lon1=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 ) 
     2724            dl_lat1=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 ) 
     2725 
     2726            IF( dl_lon1 == tl_lon1%d_fill .OR. & 
     2727            &   dl_lat1 == tl_lat1%d_fill )THEN 
    27062728               CALL logger_error("GRID GET COARSE INDEX: upper left corner "//& 
    27072729               &                 "point is FillValue. remove ghost cell "//& 
    27082730               &                 "running grid_get_coarse_index.") 
    27092731            ENDIF             
     2732 
     2733            !!!!! i-direction !!!!! 
     2734            IF( ll_even(jp_I) )THEN 
     2735               ! even 
     2736               SELECT CASE(TRIM(cl_point1)) 
     2737                  CASE('F','U') 
     2738                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   & 
     2739                        &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / & 
     2740                        &     2. 
     2741                  CASE DEFAULT 
     2742                     dl_dlon=0 
     2743               END SELECT 
     2744            ELSE 
     2745               ! odd 
     2746               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   & 
     2747                  &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / & 
     2748                  &     2. 
     2749            ENDIF 
     2750 
     2751            !!!!! j-direction !!!!! 
     2752            IF( ll_even(jp_J) )THEN 
     2753               ! even 
     2754               SELECT CASE(TRIM(cl_point1)) 
     2755                  CASE('F','V') 
     2756                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   & 
     2757                        &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / & 
     2758                        &     2. 
     2759                  CASE DEFAULT 
     2760                     dl_dlat=0 
     2761               END SELECT 
     2762            ELSE 
     2763               ! odd 
     2764               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   & 
     2765                  &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / & 
     2766                  &     2. 
     2767            ENDIF 
     2768 
     2769            dl_lon1 = dl_lon1 + dl_dlon 
     2770            dl_lat1 = dl_lat1 - dl_dlat 
     2771 
    27102772            ! look for closest point on coarse grid 
    27112773            il_iul(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
     
    27152777            &                                           il_jmin0:il_jmax0, & 
    27162778            &                                           1,1), & 
    2717             &                           dl_lon1_ul, dl_lat1_ul   ) 
    2718  
    2719             ! coarse grid point should be north west of fine grid domain 
    2720             ji = il_iul(1) 
    2721             jj = il_iul(2) 
    2722             IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dp_delta )THEN 
    2723                IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ul )THEN 
    2724                   il_iul(1)=il_iul(1)-1 
    2725                   IF( il_iul(1) <= 0 )THEN 
    2726                      IF( tl_lon0%i_ew >= 0 )THEN 
    2727                         il_iul(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew 
    2728                      ELSE 
    2729                         CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2730                         &                 "computing upper left corner "//& 
    2731                         &                 "index for longitude") 
    2732                      ENDIF 
    2733                   ENDIF 
    2734                ENDIF 
    2735             ENDIF 
    2736             IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dp_delta )THEN 
    2737                IF(tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ul )THEN 
    2738                   il_iul(2)=il_iul(2)+1 
    2739                   IF( il_ill(2) > tl_lat0%t_dim(jp_J)%i_len )THEN 
    2740                      CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2741                      &                 "computing upper left corner "//& 
    2742                      &                 "index for latitude") 
    2743                   ENDIF 
    2744                ENDIF 
    2745             ENDIF 
     2779            &                           dl_lon1, dl_lat1, 'ul' ) 
    27462780 
    27472781            !3- search lower right corner indices 
    2748             dl_lon1_lr=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 ) 
    2749             dl_lat1_lr=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 ) 
    2750  
    2751             IF( dl_lon1_lr == tl_lon1%d_fill .OR. & 
    2752             &   dl_lat1_lr == tl_lat1%d_fill )THEN 
     2782            dl_lon1=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 ) 
     2783            dl_lat1=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 ) 
     2784 
     2785            IF( dl_lon1 == tl_lon1%d_fill .OR. & 
     2786            &   dl_lat1 == tl_lat1%d_fill )THEN 
    27532787               CALL logger_error("GRID GET COARSE INDEX: lower right corner "//& 
    27542788               &                 "point is FillValue. remove ghost cell "//& 
    27552789               &                 "running grid_get_coarse_index.") 
    27562790            ENDIF             
     2791 
     2792            !!!!! i-direction !!!!! 
     2793            IF( ll_even(jp_I) )THEN 
     2794               ! even 
     2795               SELECT CASE(TRIM(cl_point1)) 
     2796                  CASE('F','U') 
     2797                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   & 
     2798                        &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / & 
     2799                        &     2. 
     2800                  CASE DEFAULT 
     2801                     dl_dlon=0 
     2802               END SELECT 
     2803            ELSE 
     2804               ! odd 
     2805               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   & 
     2806                  &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / & 
     2807                  &     2. 
     2808            ENDIF 
     2809 
     2810            !!!!! j-direction !!!!! 
     2811            IF( ll_even(jp_J) )THEN 
     2812               ! even 
     2813               SELECT CASE(TRIM(cl_point1)) 
     2814                  CASE('F','V') 
     2815                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   & 
     2816                        &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / & 
     2817                        &     2. 
     2818                  CASE DEFAULT 
     2819                     dl_dlat=0 
     2820               END SELECT 
     2821            ELSE 
     2822               ! odd 
     2823               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   & 
     2824                  &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / & 
     2825                  &     2. 
     2826            ENDIF 
     2827 
     2828            dl_lon1 = dl_lon1 - dl_dlon 
     2829            dl_lat1 = dl_lat1 + dl_dlat 
     2830 
    27572831            ! look for closest point on coarse grid 
    27582832            il_ilr(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
     
    27622836            &                                           il_jmin0:il_jmax0, & 
    27632837            &                                           1,1), & 
    2764             &                           dl_lon1_lr, dl_lat1_lr   ) 
    2765  
    2766             ! coarse grid point should be south east of fine grid domain 
    2767             ji = il_ilr(1) 
    2768             jj = il_ilr(2) 
    2769             IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_lr) > dp_delta )THEN 
    2770                IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_lr )THEN 
    2771                   il_ilr(1)=il_ilr(1)+1 
    2772                   IF( il_ilr(1) > tl_lon0%t_dim(jp_I)%i_len )THEN 
    2773                      IF( tl_lon0%i_ew >= 0 )THEN 
    2774                         il_ilr(1)=tl_lon0%i_ew+1 
    2775                      ELSE 
    2776                         CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2777                         &                 "computing lower right corner "//& 
    2778                         &                 "index for longitude") 
    2779                      ENDIF 
    2780                   ENDIF 
    2781                ENDIF 
    2782             ENDIF 
    2783             IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_lr) > dp_delta )THEN 
    2784                IF( tl_lat0%d_value(ji,jj,1,1) > dl_lat1_lr )THEN 
    2785                   il_ilr(2)=il_ilr(2)-1 
    2786                   IF( il_ilr(2) <= 0 )THEN 
    2787                      CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2788                      &                 "computing lower right corner "//& 
    2789                      &                 "index for latitude") 
    2790                   ENDIF 
    2791                ENDIF 
    2792             ENDIF 
     2838            &                           dl_lon1, dl_lat1, 'lr' ) 
    27932839 
    27942840            !4- search upper right corner indices 
    2795             dl_lon1_ur=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 ) 
    2796             dl_lat1_ur=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 ) 
    2797  
    2798             IF( dl_lon1_ur == tl_lon1%d_fill .OR. & 
    2799             &   dl_lat1_ur == tl_lat1%d_fill )THEN 
     2841            dl_lon1=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 ) 
     2842            dl_lat1=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 ) 
     2843 
     2844            IF( dl_lon1 == tl_lon1%d_fill .OR. & 
     2845            &   dl_lat1 == tl_lat1%d_fill )THEN 
    28002846               CALL logger_error("GRID GET COARSE INDEX: upper right corner "//& 
    28012847               &                 "point is FillValue. remove ghost cell "//& 
    2802                &                 "running grid_get_coarse_index.") 
     2848               &                 "before running grid_get_coarse_index.") 
    28032849            ENDIF             
     2850 
     2851            !!!!! i-direction !!!!! 
     2852            IF( ll_even(jp_I) )THEN 
     2853               ! even 
     2854               SELECT CASE(TRIM(cl_point1)) 
     2855                  CASE('F','U') 
     2856                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   & 
     2857                        &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / & 
     2858                        &     2. 
     2859                  CASE DEFAULT 
     2860                     dl_dlon=0 
     2861               END SELECT 
     2862            ELSE 
     2863               ! odd 
     2864               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   & 
     2865                  &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / & 
     2866                  &     2. 
     2867            ENDIF 
     2868 
     2869            !!!!! j-direction !!!!! 
     2870            IF( ll_even(jp_J) )THEN 
     2871               ! even 
     2872               SELECT CASE(TRIM(cl_point1)) 
     2873                  CASE('F','V') 
     2874                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   & 
     2875                        &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / & 
     2876                        &     2. 
     2877                  CASE DEFAULT 
     2878                     dl_dlat=0 
     2879               END SELECT 
     2880            ELSE 
     2881               ! odd 
     2882               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   & 
     2883                  &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / & 
     2884                  &     2. 
     2885            ENDIF 
     2886 
     2887            dl_lon1 = dl_lon1 - dl_dlon 
     2888            dl_lat1 = dl_lat1 - dl_dlat 
     2889 
    28042890            ! look for closest point on coarse grid 
    28052891            il_iur(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 
     
    28092895            &                                           il_jmin0:il_jmax0, & 
    28102896            &                                           1,1), & 
    2811             &                           dl_lon1_ur, dl_lat1_ur   ) 
    2812  
    2813             ! coarse grid point should be north east fine grid domain 
    2814             ji = il_iur(1) 
    2815             jj = il_iur(2) 
    2816             IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ur) > dp_delta )THEN 
    2817                IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_ur )THEN 
    2818                   il_iur(1)=il_iur(1)+1 
    2819                   IF( il_iur(1) > tl_lon0%t_dim(jp_I)%i_len )THEN 
    2820                      IF( tl_lon0%i_ew >= 0 )THEN 
    2821                         il_iur(1)=tl_lon0%i_ew+1 
    2822                      ELSE 
    2823                         CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2824                         &                 "computing upper right corner "//& 
    2825                         &                 "index for longitude") 
    2826                      ENDIF 
    2827                   ENDIF 
    2828                ENDIF 
    2829             ENDIF 
    2830             IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ur) > dp_delta )THEN 
    2831                IF( tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ur )THEN 
    2832                   il_iur(2)=il_iur(2)+1 
    2833                   IF( il_iur(2) > tl_lat0%t_dim(jp_J)%i_len )THEN 
    2834                      CALL logger_error("GRID GET COARSE INDEX: error "//& 
    2835                      &                 "computing upper right corner "//& 
    2836                      &                 "index for latitude") 
    2837                   ENDIF 
    2838                ENDIF 
    2839             ENDIF 
     2897            &                           dl_lon1, dl_lat1, 'ur' ) 
    28402898 
    28412899            ! coarse grid indices 
     
    29433001   END FUNCTION grid_is_global 
    29443002   !------------------------------------------------------------------- 
    2945    !> @brief This function return coarse grid indices of the closest point 
    2946    !> from fine grid point (lon1,lat1)  
     3003   !> @brief This function return grid indices of the closest point 
     3004   !> from point (lon1,lat1)  
    29473005   !>  
    29483006   !> @details 
     
    29513009   !> of longitude and latitude, before running this function 
    29523010   !> 
     3011   !> if you add cd_pos argument, you could choice to return closest point at 
     3012   !> - lower left  (ll) of the point 
     3013   !> - lower right (lr) of the point 
     3014   !> - upper left  (ul) of the point 
     3015   !> - upper right (ur) of the point 
     3016   !> - lower       (lo) of the point 
     3017   !> - upper       (up) of the point 
     3018   !> -       left  (le) of the point 
     3019   !> -       right (ri) of the point 
     3020   !> 
    29533021   !> @author J.Paul 
    29543022   !> @date November, 2013 - Initial Version 
    2955    !> @date February, 2015 - change dichotomy method to manage ORCA grid 
     3023   !> @date February, 2015 
     3024   !> - change dichotomy method to manage ORCA grid 
     3025   !> @date February, 2016 
     3026   !> - add optional use of relative position 
    29563027   ! 
    29573028   !> @param[in] dd_lon0   coarse grid array of longitude 
     
    29593030   !> @param[in] dd_lon1   fine   grid longitude 
    29603031   !> @param[in] dd_lat1   fine   grid latitude 
     3032   !> @param[in] cd_pos    relative position of grid point from point  
    29613033   !> @param[in] dd_fill   fill value 
    29623034   !> @return coarse grid indices of closest point of fine grid point 
    29633035   !------------------------------------------------------------------- 
    2964    FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, dd_fill ) 
     3036   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill ) 
    29653037      IMPLICIT NONE 
    29663038      ! Argument 
     
    29693041      REAL(dp),                 INTENT(IN) :: dd_lon1 
    29703042      REAL(dp),                 INTENT(IN) :: dd_lat1 
     3043      CHARACTER(LEN=*),         INTENT(IN), OPTIONAL :: cd_pos 
    29713044      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill 
    29723045 
     
    31473220      &                          dl_lon1, dd_lat1 ) 
    31483221 
     3222      IF( PRESENT(cd_pos) )THEN 
     3223         !  
     3224         SELECT CASE(TRIM(cd_pos)) 
     3225            CASE('le') 
     3226               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 ) 
     3227                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3228               END WHERE 
     3229            CASE('ri') 
     3230               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 ) 
     3231                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3232               END WHERE 
     3233            CASE('up') 
     3234               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 ) 
     3235                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3236               END WHERE 
     3237            CASE('lo') 
     3238               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 ) 
     3239                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3240               END WHERE 
     3241            CASE('ll') 
     3242               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. & 
     3243                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 ) 
     3244                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3245               END WHERE 
     3246            CASE('lr') 
     3247               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. & 
     3248                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 ) 
     3249                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3250               END WHERE                
     3251            CASE('ul') 
     3252               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. & 
     3253                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 ) 
     3254                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3255               END WHERE                
     3256            CASE('ur') 
     3257               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. & 
     3258                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 ) 
     3259                  dl_dist(:,:)=NF90_FILL_DOUBLE 
     3260               END WHERE 
     3261         END SELECT 
     3262      ENDIF 
    31493263      grid_get_closest(:)=MINLOC(dl_dist(:,:),dl_dist(:,:)/=NF90_FILL_DOUBLE) 
    31503264 
     
    34433557         &                                         il_imax0, il_jmax0, & 
    34443558         &                                         dl_lon1(:,:), dl_lat1(:,:),& 
    3445          &                                         id_rho(:) ) 
     3559         &                                         id_rho(:), cl_point ) 
    34463560  
    34473561         DEALLOCATE(dl_lon0, dl_lat0) 
     
    35883702         &                                         id_imax0, id_jmax0, & 
    35893703         &                                         dl_lon1(:,:), dl_lat1(:,:),& 
    3590          &                                         id_rho(:) ) 
     3704         &                                         id_rho(:), cl_point ) 
    35913705          
    35923706         DEALLOCATE(dl_lon1, dl_lat1) 
     
    36683782      ! init 
    36693783      grid__get_fine_offset_fc(:,:)=-1 
    3670  
    36713784      ALLOCATE(il_rho(ip_maxdim)) 
    36723785      il_rho(:)=1 
     
    36903803         CALL iom_mpp_open(tl_coord0) 
    36913804 
    3692          ! read coarse longitue and latitude 
     3805         ! read coarse longitude and latitude 
    36933806         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
    36943807         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
     
    37103823         ENDIF 
    37113824         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    3712           
     3825  
    37133826         ! close mpp files 
    37143827         CALL iom_mpp_close(tl_coord0) 
     
    37163829         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 
    37173830         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 
     3831 
    37183832 
    37193833         ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, & 
     
    37383852         il_jmax0=id_jmax0-il_xghost0(jp_J,1) 
    37393853 
    3740        
    37413854         !3- compute 
    37423855         grid__get_fine_offset_fc(:,:)=grid_get_fine_offset(& 
     
    37453858         &                                         il_imax0, il_jmax0, & 
    37463859         &                                         dd_lon1(:,:), dd_lat1(:,:),& 
    3747          &                                         id_rho(:) ) 
     3860         &                                         id_rho(:), cl_point ) 
    37483861          
    37493862         DEALLOCATE(dl_lon0, dl_lat0) 
     
    37673880   !> @date May, 2015  
    37683881   !> - improve way to find offset 
     3882   !> @date July, 2015 
     3883   !> - manage case close to greenwich meridian 
     3884   !> @date February, 2016 
     3885   !> - use grid_get_closest to assess offset 
     3886   !> - use delta (lon or lat) 
     3887   !> - manage cases for T,U,V or F point, with even or odd refinment 
     3888   !> - check lower left(upper right) fine grid point inside lower left(upper 
     3889   !> right) coarse grid cell. 
     3890   !>  
     3891   !> @todo check case close from North fold. 
    37693892   !> 
    37703893   !> @param[in] dd_lon0   coarse grid longitude array  
     
    37773900   !> @param[in] dd_lat1   fine   grid latitude  array 
    37783901   !> @param[in] id_rho    array of refinement factor 
     3902   !> @param[in] cd_point  Arakawa grid point 
    37793903   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /) 
    37803904   !------------------------------------------------------------------- 
    37813905   FUNCTION grid__get_fine_offset_cc( dd_lon0, dd_lat0, & 
    37823906   &                                  id_imin0, id_jmin0, id_imax0, id_jmax0, & 
    3783    &                                  dd_lon1, dd_lat1, id_rho ) 
     3907   &                                  dd_lon1, dd_lat1, id_rho, cd_point ) 
    37843908      IMPLICIT NONE 
    37853909      ! Argument 
    3786       REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lon0 
    3787       REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lat0 
    3788       REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lon1 
    3789       REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_lat1 
    3790  
    3791       INTEGER(i4),                 INTENT(IN) :: id_imin0 
    3792       INTEGER(i4),                 INTENT(IN) :: id_jmin0 
    3793       INTEGER(i4),                 INTENT(IN) :: id_imax0 
    3794       INTEGER(i4),                 INTENT(IN) :: id_jmax0 
    3795  
    3796       INTEGER(i4), DIMENSION(:)  , INTENT(IN) :: id_rho 
     3910      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon0 
     3911      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat0 
     3912      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon1 
     3913      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat1 
     3914 
     3915      INTEGER(i4)     ,                 INTENT(IN) :: id_imin0 
     3916      INTEGER(i4)     ,                 INTENT(IN) :: id_jmin0 
     3917      INTEGER(i4)     ,                 INTENT(IN) :: id_imax0 
     3918      INTEGER(i4)     ,                 INTENT(IN) :: id_jmax0 
     3919 
     3920      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN) :: id_rho 
     3921      CHARACTER(LEN=*)                , INTENT(IN), OPTIONAL :: cd_point 
    37973922 
    37983923      ! function 
     
    38003925 
    38013926      ! local variable 
     3927      CHARACTER(LEN= 1)                        :: cl_point 
     3928 
     3929      INTEGER(i4)                              :: i1 
     3930      INTEGER(i4)                              :: i2 
     3931      INTEGER(i4)                              :: j1 
     3932      INTEGER(i4)                              :: j2 
     3933 
    38023934      INTEGER(i4), DIMENSION(2)                :: il_shape0 
    38033935      INTEGER(i4), DIMENSION(2)                :: il_shape1 
    38043936 
     3937      INTEGER(i4), DIMENSION(2)                :: il_ind 
     3938 
    38053939      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
    38063940      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 
    38073941 
    3808       LOGICAL                                  :: ll_ii 
    3809       LOGICAL                                  :: ll_ij 
     3942      REAL(dp)                                 :: dl_lonmax0 
     3943      REAL(dp)                                 :: dl_latmax0 
     3944      REAL(dp)                                 :: dl_lonmin0 
     3945      REAL(dp)                                 :: dl_latmin0 
     3946 
     3947      REAL(dp)                                 :: dl_lon0F 
     3948      REAL(dp)                                 :: dl_lat0F 
     3949      REAL(dp)                                 :: dl_dlon 
     3950      REAL(dp)                                 :: dl_dlat 
     3951 
     3952      LOGICAL    , DIMENSION(2)                :: ll_even 
     3953      LOGICAL                                  :: ll_greenwich 
    38103954       
    38113955      ! loop indices 
    3812       INTEGER(i4) :: ji 
    3813       INTEGER(i4) :: jj 
    3814  
    38153956      INTEGER(i4) :: ii 
    38163957      INTEGER(i4) :: ij 
     
    38243965         CALL logger_fatal("GRID GET FINE OFFSET: dimension of fine "//& 
    38253966         &              "longitude and latitude differ") 
    3826       ENDIF       
     3967      ENDIF 
     3968 
     3969      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /) 
     3970 
     3971      cl_point='T' 
     3972      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 
    38273973 
    38283974      il_shape0(:)=SHAPE(dd_lon0(:,:)) 
    38293975      ALLOCATE( dl_lon0(il_shape0(1),il_shape0(2)) ) 
    38303976 
     3977      il_shape1(:)=SHAPE(dd_lon1(:,:)) 
     3978      ALLOCATE( dl_lon1(il_shape1(1),il_shape1(2)) ) 
     3979 
    38313980      dl_lon0(:,:)=dd_lon0(:,:) 
    38323981      WHERE( dd_lon0(:,:) < 0 ) dl_lon0(:,:)=dd_lon0(:,:)+360. 
    38333982 
    3834       il_shape1(:)=SHAPE(dd_lon1(:,:)) 
    3835       ALLOCATE( dl_lon1(il_shape1(1),il_shape1(2)) ) 
    3836  
    38373983      dl_lon1(:,:)=dd_lon1(:,:) 
    3838       WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360.          
     3984      WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360. 
    38393985 
    38403986      ! init 
    38413987      grid__get_fine_offset_cc(:,:)=-1 
     3988      ll_greenwich=.FALSE. 
    38423989 
    38433990      IF( il_shape1(jp_J) == 1 )THEN 
    3844            
     3991  
    38453992         grid__get_fine_offset_cc(jp_J,:)=((id_rho(jp_J)-1)/2) 
    38463993 
    3847          ! work on i-direction 
    3848          ! look for i-direction left offset 
    3849          IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN 
    3850             DO ji=1,id_rho(jp_I)+2 
    3851                IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) - dp_delta )THEN 
    3852                   grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ji 
    3853                   EXIT 
    3854                ENDIF 
    3855             ENDDO 
     3994         !!! work on i-direction 
     3995         !!! look for i-direction left offset 
     3996         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I)) 
     3997         j1=1 ; j2=1 
     3998 
     3999         ! check if cross greenwich meridien 
     4000         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))<5. .OR. & 
     4001           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))>355. )THEN 
     4002            ! close to greenwich meridien 
     4003            ll_greenwich=.TRUE. 
     4004            ! 0:360 => -180:180 
     4005            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) > 180. ) 
     4006               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = & 
     4007                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)-360. 
     4008            END WHERE 
     4009 
     4010            WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 
     4011               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 
     4012            END WHERE 
     4013         ENDIF 
     4014 
     4015         ! max lognitude of the left cell 
     4016         dl_lonmax0=dl_lon0(id_imin0+1,id_jmin0) 
     4017         IF( dl_lon1(1,1) < dl_lonmax0 )THEN 
     4018 
     4019            !!!!! i-direction !!!!! 
     4020            IF( ll_even(jp_I) )THEN 
     4021               ! even 
     4022               SELECT CASE(TRIM(cl_point)) 
     4023                  CASE('F','U') 
     4024                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   & 
     4025                        &       dl_lon0(id_imin0  ,id_jmin0) ) / & 
     4026                        &     ( 2.*id_rho(jp_I) ) 
     4027                  CASE DEFAULT 
     4028                     dl_dlon=0 
     4029               END SELECT 
     4030            ELSE 
     4031               ! odd 
     4032               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   & 
     4033                  &       dl_lon0(id_imin0  ,id_jmin0) ) / & 
     4034                  &     ( 2.*id_rho(jp_I) ) 
     4035            ENDIF 
     4036 
     4037            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0) + dl_dlon 
     4038            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0) 
     4039 
     4040            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4041            &                           dl_lon0F, dl_lat0F, 'le' ) 
     4042       
     4043            ii=il_ind(1) 
     4044 
     4045            !!!!! i-direction !!!!! 
     4046            IF( ll_even(jp_I) )THEN 
     4047               ! even 
     4048               SELECT CASE(TRIM(cl_point)) 
     4049                  CASE('T','V') 
     4050                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii 
     4051                  CASE DEFAULT !'F','U'  
     4052                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4053               END SELECT 
     4054            ELSE 
     4055               ! odd 
     4056               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4057            ENDIF 
     4058 
    38564059         ELSE 
    38574060            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3858             &                 " not match fine grid lower left corner.") 
    3859          ENDIF 
    3860          ! look for i-direction right offset 
    3861          IF( dl_lon1(il_shape1(jp_I),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 
    3862             DO ji=1,id_rho(jp_I)+2 
    3863                ii=il_shape1(jp_I)-ji+1 
    3864                IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN 
    3865                   grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ji 
    3866                   EXIT 
    3867                ENDIF 
    3868             ENDDO 
     4061            &                 " not match fine grid left corner.") 
     4062         ENDIF 
     4063 
     4064         IF( ll_greenwich )THEN 
     4065            ! close to greenwich meridien 
     4066            ll_greenwich=.FALSE. 
     4067            ! -180:180 => 0:360 
     4068            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) < 0. ) 
     4069               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = & 
     4070                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)+360. 
     4071            END WHERE 
     4072 
     4073            WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 
     4074               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 
     4075            END WHERE 
     4076         ENDIF 
     4077 
     4078         !!!!!! look for i-direction right offset !!!!!! 
     4079         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I) 
     4080         j1=1                                         ; j2=1 
     4081 
     4082         ! check if cross greenwich meridien 
     4083         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))<5. .OR. & 
     4084           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))>355. )THEN 
     4085            ! close to greenwich meridien 
     4086            ll_greenwich=.TRUE. 
     4087            ! 0:360 => -180:180 
     4088            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) > 180. ) 
     4089               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = & 
     4090                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)-360. 
     4091            END WHERE 
     4092 
     4093            WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 
     4094               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 
     4095            END WHERE 
     4096         ENDIF 
     4097 
     4098         ! min lognitude of the right cell 
     4099         dl_lonmin0=dl_lon0(id_imax0-1,id_jmin0) 
     4100         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 )THEN 
     4101 
     4102            !!!!! i-direction !!!!! 
     4103            IF( ll_even(jp_I) )THEN 
     4104               ! even 
     4105               SELECT CASE(TRIM(cl_point)) 
     4106                  CASE('F','U') 
     4107                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   & 
     4108                        &       dl_lon0(id_imax0-1,id_jmin0) ) / & 
     4109                        &     ( 2.*id_rho(jp_I) ) 
     4110                  CASE DEFAULT 
     4111                     dl_dlon=0 
     4112               END SELECT 
     4113            ELSE 
     4114               ! odd 
     4115               dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   & 
     4116                  &       dl_lon0(id_imax0-1,id_jmin0) ) / & 
     4117                  &     ( 2.*id_rho(jp_I) ) 
     4118            ENDIF 
     4119 
     4120            dl_lon0F= dl_lon0(id_imax0-1,id_jmin0) - dl_dlon 
     4121            dl_lat0F= dd_lat0(id_imax0-1,id_jmin0) 
     4122 
     4123            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4124            &                           dl_lon0F, dl_lat0F, 'ri' ) 
     4125 
     4126            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1) 
     4127 
     4128            !!!!! i-direction !!!!! 
     4129            IF( ll_even(jp_I) )THEN 
     4130               ! even 
     4131               SELECT CASE(TRIM(cl_point)) 
     4132                  CASE('T','V') 
     4133                     grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii 
     4134                  CASE DEFAULT !'F','U'  
     4135                     grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 
     4136               END SELECT 
     4137            ELSE 
     4138               ! odd 
     4139               grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 
     4140            ENDIF 
     4141 
    38694142         ELSE 
    38704143            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3871             &                 " not match fine grid lower right corner.") 
     4144            &                 " not match fine grid right corner.") 
     4145         ENDIF 
     4146 
     4147         IF( ll_greenwich )THEN 
     4148            ! close to greenwich meridien 
     4149            ll_greenwich=.FALSE. 
     4150            ! -180:180 => 0:360 
     4151            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) < 0. ) 
     4152               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = & 
     4153                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)+360. 
     4154            END WHERE 
     4155 
     4156            WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 
     4157               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 
     4158            END WHERE 
    38724159         ENDIF 
    38734160 
     
    38764163         grid__get_fine_offset_cc(jp_I,:)=((id_rho(jp_I)-1)/2) 
    38774164          
    3878          ! work on j-direction 
    3879  
    3880          ! look for j-direction lower offset  
    3881          IF( dd_lat1(1,1) < dd_lat0(id_imin0,id_jmin0+1) )THEN 
    3882             DO jj=1,id_rho(jp_J)+2 
    3883                IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) - dp_delta )THEN 
    3884                   grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-jj 
    3885                   EXIT 
    3886                ENDIF 
    3887             ENDDO 
     4165         !!! work on j-direction 
     4166         !!! look for j-direction lower offset  
     4167         i1=1 ; i2=1 
     4168         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J)) 
     4169 
     4170 
     4171         ! max latitude of the lower cell 
     4172         dl_latmax0=dd_lat0(id_imin0,id_jmin0+1) 
     4173         IF( dd_lat1(1,1) < dl_latmax0 )THEN 
     4174 
     4175            IF( ll_even(jp_J) )THEN 
     4176               ! even 
     4177               SELECT CASE(TRIM(cl_point)) 
     4178                  CASE('F','V') 
     4179                     dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   & 
     4180                        &       dd_lat0(id_imin0,id_jmin0  ) ) / & 
     4181                        &     ( 2.*id_rho(jp_J) ) 
     4182                  CASE DEFAULT 
     4183                     dl_dlat=0 
     4184               END SELECT 
     4185            ELSE 
     4186               ! odd 
     4187               dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   & 
     4188                  &       dd_lat0(id_imin0,id_jmin0  ) ) / & 
     4189                  &     ( 2.*id_rho(jp_J) ) 
     4190            ENDIF 
     4191 
     4192            dl_lon0F= dl_lon0(id_imin0,id_jmin0+1) 
     4193            dl_lat0F= dd_lat0(id_imin0,id_jmin0+1) + dl_dlat  
     4194             
     4195            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4196            &                           dl_lon0F, dl_lat0F, 'lo' ) 
     4197 
     4198            ij=il_ind(2) 
     4199 
     4200            !!!!! i-direction !!!!! 
     4201            IF( ll_even(jp_I) )THEN 
     4202               ! even 
     4203               SELECT CASE(TRIM(cl_point)) 
     4204                  CASE('T','V') 
     4205                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii 
     4206                  CASE DEFAULT !'F','U'  
     4207                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4208               END SELECT 
     4209            ELSE 
     4210               ! odd 
     4211               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4212            ENDIF 
     4213 
    38884214         ELSE 
    38894215            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3890             &                 " not match fine grid upper left corner.") 
    3891          ENDIF 
    3892  
    3893          ! look for j-direction upper offset  
    3894          IF( dd_lat1(1,il_shape1(jp_J)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 
    3895             DO jj=1,id_rho(jp_J)+2 
    3896                ij=il_shape1(jp_J)-jj+1 
    3897                IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) + dp_delta )THEN 
    3898                   grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-jj 
    3899                   EXIT 
    3900                ENDIF 
    3901             ENDDO 
     4216            &                 " not match fine grid lower corner.") 
     4217         ENDIF 
     4218 
     4219         !!! look for j-direction upper offset  
     4220         i1=1                                         ; i2=1 
     4221         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J) 
     4222 
     4223         ! min latitude of the upper cell 
     4224         dl_latmin0=dd_lat0(id_imin0,id_jmax0-1) 
     4225         IF( dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN 
     4226 
     4227            IF( ll_even(jp_J) )THEN 
     4228               ! even 
     4229               SELECT CASE(TRIM(cl_point)) 
     4230                  CASE('F','V') 
     4231                     dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   & 
     4232                        &       dd_lat0(id_imin0,id_jmax0-1) ) / & 
     4233                        &     ( 2.*id_rho(jp_J) ) 
     4234                  CASE DEFAULT 
     4235                     dl_dlat=0 
     4236               END SELECT 
     4237            ELSE 
     4238               ! odd 
     4239               dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   & 
     4240                  &       dd_lat0(id_imin0,id_jmax0-1) ) / & 
     4241                  &     ( 2*id_rho(jp_J) ) 
     4242            ENDIF 
     4243 
     4244            dl_lon0F= dl_lon0(id_imin0,id_jmax0-1)  
     4245            dl_lat0F= dd_lat0(id_imin0,id_jmax0-1) - dl_dlat 
     4246             
     4247            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4248            &                           dl_lon0F, dl_lat0F, 'up' ) 
     4249 
     4250            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1) 
     4251 
     4252            !!!!! j-direction !!!!! 
     4253            IF( ll_even(jp_J) )THEN 
     4254               ! even 
     4255               SELECT CASE(TRIM(cl_point)) 
     4256                  CASE('T','U') 
     4257                     grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij 
     4258                  CASE DEFAULT !'F','V' 
     4259                     grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 
     4260               END SELECT 
     4261            ELSE 
     4262               ! odd 
     4263               grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 
     4264            ENDIF 
     4265 
    39024266         ELSE 
    39034267            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
     4268            &                 " not match fine grid upper corner.") 
     4269         ENDIF 
     4270 
     4271      ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1  
     4272 
     4273         !!!!!! look for lower left offset !!!!!! 
     4274         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I)) 
     4275         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J)) 
     4276 
     4277         ! check if cross greenwich meridien 
     4278         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))<5. .OR. & 
     4279           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))>355. )THEN 
     4280            ! close to greenwich meridien 
     4281            ll_greenwich=.TRUE. 
     4282            ! 0:360 => -180:180 
     4283            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) > 180. ) 
     4284               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = & 
     4285                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)-360. 
     4286            END WHERE 
     4287 
     4288            WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 
     4289               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 
     4290            END WHERE 
     4291         ENDIF 
     4292 
     4293         ! max longitude of the lower left cell 
     4294         dl_lonmax0=MAX(dl_lon0(id_imin0+1,id_jmin0),dl_lon0(id_imin0+1,id_jmin0+1)) 
     4295         ! max latitude of the lower left cell 
     4296         dl_latmax0=MAX(dd_lat0(id_imin0,id_jmin0+1),dd_lat0(id_imin0+1,id_jmin0+1)) 
     4297         IF( dl_lon1(1,1) < dl_lonmax0 .AND. & 
     4298           & dd_lat1(1,1) < dl_latmax0 )THEN 
     4299 
     4300            !!!!! i-direction !!!!! 
     4301            IF( ll_even(jp_I) )THEN 
     4302               ! even 
     4303               SELECT CASE(TRIM(cl_point)) 
     4304                  CASE('F','U') 
     4305                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   & 
     4306                        &       dl_lon0(id_imin0  ,id_jmin0+1) ) / & 
     4307                        &     ( 2.*id_rho(jp_I) ) 
     4308                  CASE DEFAULT 
     4309                     dl_dlon=0 
     4310               END SELECT 
     4311            ELSE 
     4312               ! odd 
     4313               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   & 
     4314                  &       dl_lon0(id_imin0  ,id_jmin0+1) ) / & 
     4315                  &     ( 2.*id_rho(jp_I) ) 
     4316            ENDIF 
     4317 
     4318            !!!!! j-direction !!!!! 
     4319            IF( ll_even(jp_J) )THEN 
     4320               ! even 
     4321               SELECT CASE(TRIM(cl_point)) 
     4322                  CASE('F','V') 
     4323                     dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   & 
     4324                        &       dd_lat0(id_imin0+1,id_jmin0  ) ) / & 
     4325                        &     ( 2.*id_rho(jp_J) ) 
     4326                  CASE DEFAULT 
     4327                     dl_dlat=0 
     4328               END SELECT 
     4329            ELSE 
     4330               ! odd 
     4331               dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   & 
     4332                  &       dd_lat0(id_imin0+1,id_jmin0  ) ) / & 
     4333                  &     ( 2.*id_rho(jp_J) ) 
     4334            ENDIF 
     4335 
     4336            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0+1) + dl_dlon 
     4337            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0+1) + dl_dlat 
     4338 
     4339            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4340            &                           dl_lon0F, dl_lat0F, 'll' ) 
     4341 
     4342            ii=il_ind(1) 
     4343            ij=il_ind(2) 
     4344 
     4345            !!!!! i-direction !!!!! 
     4346            IF( ll_even(jp_I) )THEN 
     4347               ! even 
     4348               SELECT CASE(TRIM(cl_point)) 
     4349                  CASE('T','V') 
     4350                     grid__get_fine_offset_cc(jp_I,1)=id_rho(jp_I)-ii 
     4351                  CASE DEFAULT !'F','U'  
     4352                     grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4353               END SELECT 
     4354            ELSE 
     4355               ! odd 
     4356               grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
     4357            ENDIF 
     4358 
     4359            !!!!! j-direction !!!!! 
     4360            IF( ll_even(jp_J) )THEN 
     4361               ! even 
     4362               SELECT CASE(TRIM(cl_point)) 
     4363                  CASE('T','U') 
     4364                     grid__get_fine_offset_cc(jp_J,1)=id_rho(jp_J)-ij 
     4365                  CASE DEFAULT !'F','V' 
     4366                     grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij 
     4367               END SELECT 
     4368            ELSE 
     4369               ! odd 
     4370               grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij 
     4371            ENDIF 
     4372 
     4373         ELSE 
     4374            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//& 
     4375            &                 " not match fine grid lower left corner.") 
     4376         ENDIF 
     4377 
     4378         IF( ll_greenwich )THEN 
     4379            ! close to greenwich meridien 
     4380            ll_greenwich=.FALSE. 
     4381            ! -180:180 => 0:360  
     4382            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) < 0. ) 
     4383               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = & 
     4384                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)+360. 
     4385            END WHERE 
     4386 
     4387            WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 
     4388               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 
     4389            END WHERE 
     4390         ENDIF 
     4391 
     4392         !!!!!! look for upper right offset !!!!!! 
     4393         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I) 
     4394         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J) 
     4395 
     4396         ! check if cross greenwich meridien 
     4397         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))<5. .OR. & 
     4398           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))>355. )THEN 
     4399            ! close to greenwich meridien 
     4400            ll_greenwich=.TRUE. 
     4401            ! 0:360 => -180:180 
     4402            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) > 180. ) 
     4403               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = & 
     4404                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)-360. 
     4405            END WHERE 
     4406 
     4407            WHERE( dl_lon1(i1:i2,j1:j2) > 180. ) 
     4408               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360. 
     4409            END WHERE 
     4410         ENDIF 
     4411 
     4412         ! min latitude of the upper right cell 
     4413         dl_lonmin0=MIN(dl_lon0(id_imax0-1,id_jmax0-1),dl_lon0(id_imax0-1,id_jmax0)) 
     4414         ! min latitude of the upper right cell 
     4415         dl_latmin0=MIN(dd_lat0(id_imax0-1,id_jmax0-1),dd_lat0(id_imax0,id_jmax0-1)) 
     4416         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 .AND. & 
     4417           & dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN 
     4418 
     4419            !!!!! i-direction !!!!! 
     4420            IF( ll_even(jp_I) )THEN 
     4421               ! even 
     4422               SELECT CASE(TRIM(cl_point)) 
     4423                  CASE('F','U') 
     4424                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   & 
     4425                        &       dl_lon0(id_imax0-1,id_jmax0-1) ) / & 
     4426                        &     ( 2.*id_rho(jp_I) ) 
     4427                  CASE DEFAULT 
     4428                     dl_dlon=0 
     4429               END SELECT                
     4430            ELSE 
     4431               ! odd 
     4432               dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   & 
     4433                  &       dl_lon0(id_imax0-1,id_jmax0-1) ) / & 
     4434                  &     ( 2*id_rho(jp_I) ) 
     4435            ENDIF 
     4436 
     4437            !!!!! j-direction !!!!! 
     4438            IF( ll_even(jp_J) )THEN 
     4439               ! even 
     4440               SELECT CASE(TRIM(cl_point)) 
     4441                  CASE('F','V') 
     4442                     dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   & 
     4443                        &       dd_lat0(id_imax0-1,id_jmax0-1) ) / & 
     4444                        &     ( 2.*id_rho(jp_J) ) 
     4445                  CASE DEFAULT 
     4446                     dl_dlat=0 
     4447               END SELECT 
     4448            ELSE 
     4449               ! odd 
     4450               dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   & 
     4451                  &       dd_lat0(id_imax0-1,id_jmax0-1) ) / & 
     4452                  &     ( 2*id_rho(jp_J) ) 
     4453            ENDIF 
     4454 
     4455            dl_lon0F= dl_lon0(id_imax0-1,id_jmax0-1) - dl_dlon 
     4456            dl_lat0F= dd_lat0(id_imax0-1,id_jmax0-1) - dl_dlat 
     4457 
     4458            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), & 
     4459            &                           dl_lon0F, dl_lat0F, 'ur' ) 
     4460 
     4461            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1) 
     4462            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1) 
     4463 
     4464            !!!!! i-direction !!!!! 
     4465            IF( ll_even(jp_I) )THEN 
     4466               ! even 
     4467               SELECT CASE(TRIM(cl_point)) 
     4468                  CASE('T','V') 
     4469                     grid__get_fine_offset_cc(jp_I,2)=id_rho(jp_I)-ii 
     4470                  CASE DEFAULT !'F','U'  
     4471                     grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 
     4472               END SELECT 
     4473            ELSE 
     4474               ! odd 
     4475               grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ii 
     4476            ENDIF 
     4477 
     4478            !!!!! j-direction !!!!! 
     4479            IF( ll_even(jp_J) )THEN 
     4480               ! even 
     4481               SELECT CASE(TRIM(cl_point)) 
     4482                  CASE('T','U') 
     4483                     grid__get_fine_offset_cc(jp_J,2)=id_rho(jp_J)-ij 
     4484                  CASE DEFAULT !'F','V' 
     4485                     grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 
     4486               END SELECT 
     4487            ELSE 
     4488               ! odd 
     4489               grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-ij 
     4490            ENDIF 
     4491 
     4492         ELSE 
     4493            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//& 
    39044494            &                 " not match fine grid upper right corner.") 
    3905          ENDIF          
    3906  
    3907       ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1  
    3908  
    3909          ! look for lower left offset 
    3910          IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0+1) )THEN 
    3911  
    3912             ii=1 
    3913             ij=1 
    3914             DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2) 
    3915  
    3916                ll_ii=.FALSE. 
    3917                ll_ij=.FALSE. 
    3918  
    3919                IF( dl_lon1(ii,ij) >= dl_lon0(id_imin0+1,id_jmin0+1)-dp_delta .AND. & 
    3920                &   dd_lat1(ii,ij) >= dd_lat0(id_imin0+1,id_jmin0+1)-dp_delta )THEN 
    3921                   grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
    3922                   grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij 
    3923                   EXIT 
    3924                ENDIF 
    3925  
    3926                IF( dl_lon1(ii+1,ij) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. & 
    3927                &   dd_lat1(ii+1,ij) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN 
    3928                   ll_ii=.TRUE. 
    3929                ENDIF 
    3930                IF( dl_lon1(ii,ij+1) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. & 
    3931                &   dd_lat1(ii,ij+1) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN 
    3932                   ll_ij=.TRUE. 
    3933                ENDIF 
    3934  
    3935                IF( ll_ii ) ii=ii+1 
    3936                IF( ll_ij ) ij=ij+1 
    3937  
    3938             ENDDO 
    3939  
    3940          ELSE 
    3941             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3942             &                 " not match fine grid lower left corner.") 
    3943          ENDIF 
    3944  
    3945          ! look for upper right offset 
    3946          IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > & 
    3947             & dl_lon0(id_imax0-1,id_jmax0-1) )THEN 
    3948  
    3949             ii=il_shape1(jp_I) 
    3950             ij=il_shape1(jp_J) 
    3951             DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2) 
    3952  
    3953                ll_ii=.FALSE. 
    3954                ll_ij=.FALSE. 
    3955  
    3956                IF( dl_lon1(ii,ij) <= dl_lon0(id_imax0-1,id_jmax0-1)+dp_delta .AND. & 
    3957                &   dd_lat1(ii,ij) <= dd_lat0(id_imax0-1,id_jmax0-1)+dp_delta )THEN 
    3958                   grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-(il_shape1(jp_I)+1-ii) 
    3959                   grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-(il_shape1(jp_J)+1-ij) 
    3960                   EXIT 
    3961                ENDIF 
    3962  
    3963                IF( dl_lon1(ii-1,ij) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. & 
    3964                &   dd_lat1(ii-1,ij) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN 
    3965                   ll_ii=.TRUE. 
    3966                ENDIF 
    3967                IF( dl_lon1(ii,ij-1) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. & 
    3968                &   dd_lat1(ii,ij-1) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN 
    3969                   ll_ij=.TRUE. 
    3970                ENDIF 
    3971  
    3972                IF( ll_ii ) ii=ii-1 
    3973                IF( ll_ij ) ij=ij-1 
    3974  
    3975             ENDDO 
    3976  
    3977          ELSE 
    3978             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3979             &                 " not match fine grid upper right corner.") 
     4495         ENDIF 
     4496 
     4497         IF( ll_greenwich )THEN 
     4498            ! close to greenwich meridien 
     4499            ll_greenwich=.FALSE. 
     4500            ! -180:180 => 0:360 
     4501            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) < 0. ) 
     4502               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = & 
     4503                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)+360. 
     4504            END WHERE 
     4505 
     4506            WHERE( dl_lon1(i1:i2,j1:j2) < 0. ) 
     4507               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360. 
     4508            END WHERE 
    39804509         ENDIF 
    39814510 
     
    39844513      DEALLOCATE( dl_lon0 ) 
    39854514      DEALLOCATE( dl_lon1 ) 
     4515 
     4516      IF( ANY(grid__get_fine_offset_cc(:,:)==-1) )THEN 
     4517         CALL logger_fatal("GRID GET FINE OFFSET: can not found "//& 
     4518         &                 " offset between coarse and fine grid.") 
     4519      ENDIF 
    39864520 
    39874521   END FUNCTION grid__get_fine_offset_cc 
     
    39954529   !> @date October, 2014 
    39964530   !> - work on mpp file structure instead of file structure 
    3997    ! 
     4531   !> @date February, 2016 
     4532   !> - use F-point to check coincidence for even refinment 
     4533   !> - use F-point estimation, if can not read it. 
     4534   !> 
    39984535   !> @param[in] td_coord0 coarse grid coordinate file structure  
    39994536   !> @param[in] td_coord1 fine   grid coordinate file structure  
     
    40204557 
    40214558      ! local variable 
    4022       INTEGER(i4) :: il_imid1 
    4023       INTEGER(i4) :: il_jmid1 
     4559      INTEGER(i4)               :: il_imid1 
     4560      INTEGER(i4)               :: il_jmid1 
    40244561       
    4025       INTEGER(i4) :: il_ew0 
    4026       INTEGER(i4) :: il_ew1 
    4027  
    4028       INTEGER(i4) :: il_imin1 
    4029       INTEGER(i4) :: il_imax1 
    4030       INTEGER(i4) :: il_jmin1 
    4031       INTEGER(i4) :: il_jmax1 
    4032  
    4033       INTEGER(i4), DIMENSION(2) :: il_indC 
    4034       INTEGER(i4), DIMENSION(2) :: il_indF 
    4035       INTEGER(i4), DIMENSION(2) :: il_iind 
    4036       INTEGER(i4), DIMENSION(2) :: il_jind 
    4037  
    4038       REAL(dp)    :: dl_lon0 
    4039       REAL(dp)    :: dl_lat0 
    4040       REAL(dp)    :: dl_lon1 
    4041       REAL(dp)    :: dl_lat1 
    4042  
    4043       REAL(dp)    :: dl_lon1p 
    4044       REAL(dp)    :: dl_lat1p 
    4045  
    4046       LOGICAL     :: ll_coincidence 
    4047  
    4048       TYPE(TVAR)  :: tl_lon0 
    4049       TYPE(TVAR)  :: tl_lat0 
    4050       TYPE(TVAR)  :: tl_lon1 
    4051       TYPE(TVAR)  :: tl_lat1 
    4052  
    4053       TYPE(TMPP)  :: tl_coord0 
    4054       TYPE(TMPP)  :: tl_coord1 
    4055  
    4056       TYPE(TDOM)  :: tl_dom0 
     4562      INTEGER(i4)               :: il_ew0 
     4563      INTEGER(i4)               :: il_ew1 
     4564 
     4565      INTEGER(i4)               :: il_ind 
     4566 
     4567      INTEGER(i4)               :: il_imin1 
     4568      INTEGER(i4)               :: il_imax1 
     4569      INTEGER(i4)               :: il_jmin1 
     4570      INTEGER(i4)               :: il_jmax1 
     4571 
     4572      INTEGER(i4), DIMENSION(2) :: il_ind0 
     4573      INTEGER(i4), DIMENSION(2) :: il_ind1 
     4574 
     4575      INTEGER(i4), DIMENSION(2) :: il_ill1 
     4576      INTEGER(i4), DIMENSION(2) :: il_ilr1 
     4577      INTEGER(i4), DIMENSION(2) :: il_iul1 
     4578      INTEGER(i4), DIMENSION(2) :: il_iur1 
     4579 
     4580      REAL(dp)                  :: dl_lon0F 
     4581      REAL(dp)                  :: dl_lat0F 
     4582      REAL(dp)                  :: dl_lon0 
     4583      REAL(dp)                  :: dl_lat0 
     4584      REAL(dp)                  :: dl_lon1F 
     4585      REAL(dp)                  :: dl_lat1F 
     4586      REAL(dp)                  :: dl_lon1 
     4587      REAL(dp)                  :: dl_lat1 
     4588 
     4589      REAL(dp)                  :: dl_delta 
     4590 
     4591      LOGICAL                   :: ll_coincidence 
     4592      LOGICAL                   :: ll_even 
     4593      LOGICAL                   :: ll_grid0F 
     4594      LOGICAL                   :: ll_grid1F 
     4595 
     4596      TYPE(TVAR)                :: tl_lon0 
     4597      TYPE(TVAR)                :: tl_lat0 
     4598      TYPE(TVAR)                :: tl_lon0F 
     4599      TYPE(TVAR)                :: tl_lat0F 
     4600      TYPE(TVAR)                :: tl_lon1 
     4601      TYPE(TVAR)                :: tl_lat1 
     4602      TYPE(TVAR)                :: tl_lon1F 
     4603      TYPE(TVAR)                :: tl_lat1F 
     4604 
     4605      TYPE(TMPP)                :: tl_coord0 
     4606      TYPE(TMPP)                :: tl_coord1 
     4607 
     4608      TYPE(TDOM)                :: tl_dom0 
    40574609 
    40584610      ! loop indices 
     
    40634615      ll_coincidence=.TRUE. 
    40644616 
     4617      ll_even=.FALSE. 
     4618      IF( MOD(id_rho(jp_I)*id_rho(jp_J),2) == 0 )THEN 
     4619         ll_even=.TRUE. 
     4620      ENDIF 
     4621 
    40654622      ! copy structure 
    40664623      tl_coord0=mpp_copy(td_coord0) 
     
    40754632 
    40764633      ! read variable value on domain 
    4077       tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0) 
    4078       tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0) 
     4634      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_T') 
     4635      IF( il_ind /= 0 )THEN 
     4636         tl_lon0=iom_dom_read_var(tl_coord0,'longitude_T',tl_dom0) 
     4637      ELSE 
     4638         tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0) 
     4639      ENDIF 
     4640 
     4641      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_T') 
     4642      IF( il_ind /= 0 )THEN 
     4643         tl_lat0=iom_dom_read_var(tl_coord0,'latitude_T' ,tl_dom0) 
     4644      ELSE 
     4645         tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0) 
     4646      ENDIF 
     4647 
     4648      IF( ll_even )THEN 
     4649         ! look for variable value on domain for F point 
     4650         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_F') 
     4651         IF( il_ind /= 0 )THEN 
     4652            tl_lon0F=iom_dom_read_var(tl_coord0,'longitude_F',tl_dom0) 
     4653         ENDIF 
     4654 
     4655         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_F') 
     4656         IF( il_ind /= 0 )THEN 
     4657            tl_lat0F=iom_dom_read_var(tl_coord0,'latitude_F' ,tl_dom0) 
     4658         ENDIF 
     4659 
     4660         ll_grid0F=.FALSE. 
     4661         IF( ASSOCIATED(tl_lon0F%d_value) .AND. & 
     4662         &   ASSOCIATED(tl_lat0F%d_value) )THEN 
     4663            ll_grid0F=.TRUE. 
     4664         ENDIF 
     4665 
     4666      ENDIF 
    40794667 
    40804668      ! close mpp files 
     
    40924680 
    40934681      ! read fine longitue and latitude 
    4094       tl_lon1=iom_mpp_read_var(tl_coord1,'longitude') 
    4095       tl_lat1=iom_mpp_read_var(tl_coord1,'latitude') 
     4682      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lon0%c_longname)) 
     4683      IF( il_ind /= 0 )THEN 
     4684         tl_lon1=iom_mpp_read_var(tl_coord1,TRIM(tl_lon0%c_longname)) 
     4685      ELSE 
     4686         tl_lon1=iom_mpp_read_var(tl_coord1,'longitude') 
     4687      ENDIF 
     4688      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lat0%c_longname)) 
     4689      IF( il_ind /= 0 )THEN 
     4690         tl_lat1=iom_mpp_read_var(tl_coord1,TRIM(tl_lat0%c_longname)) 
     4691      ELSE 
     4692         tl_lat1=iom_mpp_read_var(tl_coord1,'latitude') 
     4693      ENDIF 
    40964694       
     4695      IF( ll_even )THEN 
     4696 
     4697         ! look for variable value on domain for F point 
     4698         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'longitude_F') 
     4699         IF( il_ind /= 0 )THEN 
     4700            tl_lon1F=iom_mpp_read_var(tl_coord1,'longitude_F') 
     4701         ENDIF 
     4702 
     4703         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'latitude_F') 
     4704         IF( il_ind /= 0 )THEN 
     4705            tl_lat1F=iom_mpp_read_var(tl_coord1,'latitude_F') 
     4706         ENDIF 
     4707 
     4708         ll_grid1F=.FALSE. 
     4709         IF( ASSOCIATED(tl_lon1F%d_value) .AND. & 
     4710         &   ASSOCIATED(tl_lat1F%d_value) )THEN 
     4711            ll_grid1F=.TRUE. 
     4712         ENDIF 
     4713 
     4714      ENDIF 
     4715 
    40974716      ! close mpp files 
    4098       CALL iom_dom_close(tl_coord1) 
     4717      CALL iom_mpp_close(tl_coord1) 
    40994718      ! clean structure 
    41004719      CALL mpp_clean(tl_coord1) 
     
    41584777         IF( .NOT. ll_coincidence )THEN 
    41594778            CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//& 
    4160             &              "between fine grid and coarse grid. invalid domain" ) 
     4779            &              "between fine grid and coarse grid: invalid domain." ) 
    41614780         ENDIF 
    41624781 
     
    41724791 
    41734792      ! select closest point on coarse grid 
    4174       il_indC(:)=grid_get_closest(tl_lon0%d_value(:,:,1,1),& 
     4793      il_ind0(:)=grid_get_closest(tl_lon0%d_value(:,:,1,1),& 
    41754794      &                           tl_lat0%d_value(:,:,1,1),& 
    41764795      &                           dl_lon1, dl_lat1   ) 
    41774796 
    4178       IF( ANY(il_indC(:)==0) )THEN 
     4797      IF( ANY(il_ind0(:)==0) )THEN 
    41794798         CALL logger_fatal("GRID CHECK COINCIDENCE: can not find valid "//& 
    4180          &              "coarse grid indices. invalid domain" ) 
    4181       ENDIF 
    4182  
    4183       dl_lon0=tl_lon0%d_value(il_indC(1),il_indC(2),1,1) 
    4184       dl_lat0=tl_lat0%d_value(il_indC(1),il_indC(2),1,1) 
    4185  
    4186       ! look for closest fine grid point from selected coarse grid point 
    4187       il_iind(:)=MAXLOC( tl_lon1%d_value(:,:,1,1), & 
    4188       &                  tl_lon1%d_value(:,:,1,1) <= dl_lon0 ) 
    4189  
    4190       il_jind(:)=MAXLOC( tl_lat1%d_value(:,:,1,1), & 
    4191       &                  tl_lat1%d_value(:,:,1,1) <= dl_lat0 ) 
    4192  
    4193       il_indF(1)=il_iind(1) 
    4194       il_indF(2)=il_jind(2) 
    4195  
    4196       IF( ANY(il_indF(:)==0) )THEN 
    4197          CALL logger_fatal("GRID CHECK COINCIDENCE: can not find valid "//& 
    4198          &              "fine grid indices. invalid domain" ) 
    4199       ENDIF 
    4200  
    4201       dl_lon1=tl_lon1%d_value(il_indF(1),il_indF(2),1,1) 
    4202       dl_lat1=tl_lat1%d_value(il_indF(1),il_indF(2),1,1) 
    4203  
    4204       ! check i-direction refinement factor 
    4205       DO ji=1,MIN(3,il_imid1) 
    4206  
    4207          IF( il_indF(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN 
    4208             CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
    4209             &  " to check i-direction refinement factor ") 
    4210             EXIT 
    4211          ELSE 
    4212             dl_lon1=tl_lon1%d_value(il_indF(1)+ji*id_rho(jp_I),il_indF(2),1,1) 
    4213             dl_lon0=tl_lon0%d_value(il_indC(1)+ji,il_indC(2),1,1) 
    4214  
    4215             dl_lon1p=tl_lon1%d_value(il_indF(1)+ji*id_rho(jp_I)+1,il_indF(2),1,1) 
    4216  
    4217             SELECT CASE(MOD(id_rho(jp_I),2)) 
    4218  
    4219             CASE(0) 
    4220  
    4221                IF( dl_lon1 >= dl_lon0 .OR. dl_lon0 >= dl_lon1p )THEN 
    4222                   ll_coincidence=.FALSE. 
    4223                   CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 
    4224                   &  "i-direction refinement factor ("//& 
    4225                   &   TRIM(fct_str(id_rho(jp_I)))//& 
    4226                   &   ") between fine grid and coarse grid ") 
    4227                ENDIF 
    4228  
    4229             CASE DEFAULT          
    4230              
     4799         &              "coarse grid indices: invalid domain." ) 
     4800      ENDIF 
     4801 
     4802      IF( .NOT. ll_even )THEN 
     4803         ! case odd refinment in both direction 
     4804         ! work on T-point 
     4805 
     4806         dl_lon0=tl_lon0%d_value(il_ind0(1),il_ind0(2),1,1) 
     4807         dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2),1,1) 
     4808 
     4809         il_ind1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 
     4810         &                           tl_lat1%d_value(:,:,1,1),& 
     4811         &                           dl_lon0, dl_lat0 ) 
     4812 
     4813         ! check i-direction refinement factor 
     4814         DO ji=0,MIN(3,il_imid1) 
     4815 
     4816            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN 
     4817               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
     4818               &  " to check i-direction refinement factor ") 
     4819               EXIT 
     4820            ELSE 
     4821               dl_lon0=tl_lon0%d_value(il_ind0(1)+ji             ,il_ind0(2),1,1) 
     4822               dl_lon1=tl_lon1%d_value(il_ind1(1)+ji*id_rho(jp_I),il_ind1(2),1,1) 
     4823 
     4824               ! assume there could be little difference due to interpolation 
    42314825               IF( ABS(dl_lon1 - dl_lon0) > dp_delta )THEN 
    42324826                  ll_coincidence=.FALSE. 
     
    42364830                  &  ") between fine grid and coarse grid ") 
    42374831               ENDIF 
    4238              
    4239             END SELECT 
    4240          ENDIF 
    4241  
    4242       ENDDO 
    4243  
    4244       ! check j-direction refinement factor 
    4245       DO jj=1,MIN(3,il_jmid1) 
    4246  
    4247          IF( il_indF(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN 
    4248             CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
    4249             &  " to check j-direction refinement factor ") 
    4250             EXIT 
    4251          ELSE       
    4252             dl_lat1=tl_lat1%d_value(il_indF(1),il_indF(2)+jj*id_rho(jp_J),1,1) 
    4253             dl_lat0=tl_lat0%d_value(il_indC(1),il_indC(2)+jj,1,1) 
    4254  
    4255             dl_lat1p=tl_lat1%d_value(il_indF(1),il_indF(2)+jj*id_rho(jp_J)+1,1,1) 
    4256  
    4257             SELECT CASE(MOD(id_rho(jp_J),2)) 
    4258  
    4259             CASE(0) 
    4260                 
    4261                IF( dl_lat1 >= dl_lat0 .OR. dl_lat0 >= dl_lat1p )THEN 
    4262                   ll_coincidence=.FALSE. 
    4263                   CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 
    4264                   &  "j-direction refinement factor ("//& 
    4265                   &   TRIM(fct_str(id_rho(jp_J)))//& 
    4266                   &  ") between fine grid and coarse grid ") 
    4267                ENDIF 
    4268  
    4269             CASE DEFAULT 
    4270  
     4832            ENDIF 
     4833 
     4834         ENDDO 
     4835 
     4836         ! check j-direction refinement factor 
     4837         DO jj=0,MIN(3,il_jmid1) 
     4838 
     4839            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN 
     4840               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
     4841               &  " to check j-direction refinement factor ") 
     4842               EXIT 
     4843            ELSE       
     4844               dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2)+jj             ,1,1) 
     4845               dl_lat1=tl_lat1%d_value(il_ind1(1),il_ind1(2)+jj*id_rho(jp_J),1,1) 
     4846 
     4847               ! assume there could be little difference due to interpolation 
    42714848               IF( ABS(dl_lat1-dl_lat0) > dp_delta )THEN 
    42724849                  ll_coincidence=.FALSE. 
     
    42764853                  &  ") between fine grid and coarse grid ") 
    42774854               ENDIF 
    4278  
    4279             END SELECT 
    4280          ENDIF 
    4281  
    4282       ENDDO 
     4855            ENDIF 
     4856 
     4857         ENDDO 
     4858 
     4859      ELSE 
     4860         ! case even refinment at least in one direction 
     4861         ! work on F-point 
     4862 
     4863         dl_delta=dp_delta 
     4864         ! look for lower left fine point in coarse cell. 
     4865         IF( ll_grid0F )THEN 
     4866       
     4867            ! lower left corner of coarse cell 
     4868            dl_lon0F=tl_lon0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) 
     4869            dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) 
     4870 
     4871         ELSE 
     4872 
     4873            ! approximate lower left corner of coarse cell (with T point) 
     4874            dl_lon0F=( tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + & 
     4875            &          tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + & 
     4876            &          tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + & 
     4877            &          tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25 
     4878 
     4879            dl_lat0F=( tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + & 
     4880            &          tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + & 
     4881            &          tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + & 
     4882            &          tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25 
     4883 
     4884            ! as we use approximation of F-point we relax condition 
     4885            dl_delta=100*dp_delta 
     4886 
     4887         ENDIF 
     4888 
     4889         IF( ll_grid1F )THEN 
     4890       
     4891            il_ind1(:)=grid_get_closest(tl_lon1F%d_value(:,:,1,1),& 
     4892            &                           tl_lat1F%d_value(:,:,1,1),& 
     4893            &                           dl_lon0F, dl_lat0F ) 
     4894 
     4895         ELSE 
     4896 
     4897            il_ill1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 
     4898            &                           tl_lat1%d_value(:,:,1,1),& 
     4899            &                           dl_lon0F, dl_lat0F, 'll' ) 
     4900 
     4901            il_ilr1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 
     4902            &                           tl_lat1%d_value(:,:,1,1),& 
     4903            &                           dl_lon0F, dl_lat0F, 'lr' ) 
     4904 
     4905            il_iul1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 
     4906            &                           tl_lat1%d_value(:,:,1,1),& 
     4907            &                           dl_lon0F, dl_lat0F, 'ul' ) 
     4908 
     4909            il_iur1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),& 
     4910            &                           tl_lat1%d_value(:,:,1,1),& 
     4911            &                           dl_lon0F, dl_lat0F, 'ur' ) 
     4912 
     4913            ! as we use approximation of F-point we relax condition 
     4914            dl_delta=100*dp_delta 
     4915 
     4916         ENDIF 
     4917 
     4918         ! check i-direction refinement factor 
     4919         DO ji=0,MIN(3,il_imid1) 
     4920 
     4921            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN 
     4922               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
     4923               &  " to check i-direction refinement factor ") 
     4924               EXIT 
     4925            ELSE 
     4926               IF( ll_grid0F )THEN 
     4927                  dl_lon0F=tl_lon0F%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1) 
     4928               ELSE 
     4929                  dl_lon0F= 0.25 * & 
     4930                  & ( tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)  ,1,1) + & 
     4931                  &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)  ,1,1) + & 
     4932                  &   tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)-1,1,1) + & 
     4933                  &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1) ) 
     4934               ENDIF 
     4935 
     4936               IF( ll_grid1F )THEN 
     4937                  dl_lon1F= tl_lon1F%d_value( il_ind1(1)+ji*id_rho(jp_I), & 
     4938                                            & il_ind1(2),1,1) 
     4939               ELSE 
     4940                  dl_lon1F= 0.25 * & 
     4941                  & ( tl_lon1%d_value( il_ill1(1)+ji*id_rho(jp_I), & 
     4942                                     & il_ill1(2),1,1) + & 
     4943                  &   tl_lon1%d_value( il_ilr1(1)+ji*id_rho(jp_I), & 
     4944                                     & il_ilr1(2),1,1) + & 
     4945                  &   tl_lon1%d_value( il_iul1(1)+ji*id_rho(jp_I), & 
     4946                                     & il_iul1(2),1,1) + & 
     4947                  &   tl_lon1%d_value( il_iur1(1)+ji*id_rho(jp_I), & 
     4948                                     & il_iur1(2),1,1) ) 
     4949                   
     4950               ENDIF 
     4951 
     4952               ! assume there could be little difference due to interpolation 
     4953               IF( ABS(dl_lon1F - dl_lon0F) > dl_delta )THEN 
     4954                  ll_coincidence=.FALSE. 
     4955                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 
     4956                  &  "i-direction refinement factor ("//& 
     4957                  &   TRIM(fct_str(id_rho(jp_I)))//& 
     4958                  &  ") between fine grid and coarse grid ") 
     4959               ENDIF 
     4960            ENDIF 
     4961 
     4962         ENDDO 
     4963 
     4964         ! check j-direction refinement factor 
     4965         DO jj=0,MIN(3,il_jmid1) 
     4966 
     4967            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN 
     4968               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 
     4969               &  " to check j-direction refinement factor ") 
     4970               EXIT 
     4971            ELSE       
     4972               IF( ll_grid0F )THEN 
     4973                  dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1) 
     4974               ELSE 
     4975                  dl_lat0F= 0.25 * & 
     4976                  & ( tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj  ,1,1) + & 
     4977                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj  ,1,1) + & 
     4978                  &   tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj-1,1,1) + & 
     4979                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1) ) 
     4980               ENDIF 
     4981 
     4982               IF( ll_grid1F )THEN 
     4983                  dl_lat1F= tl_lat1F%d_value( il_ind1(1), & 
     4984                                            & il_ind1(2)+jj*id_rho(jp_J),1,1) 
     4985               ELSE 
     4986                  dl_lat1F= 0.25 * & 
     4987                  & ( tl_lat1%d_value( il_ill1(1), & 
     4988                                     & il_ill1(2)+jj*id_rho(jp_J),1,1) + & 
     4989                  &   tl_lat1%d_value( il_ilr1(1), & 
     4990                                     & il_ilr1(2)+jj*id_rho(jp_J),1,1) + & 
     4991                  &   tl_lat1%d_value( il_iul1(1), & 
     4992                                     & il_iul1(2)+jj*id_rho(jp_J),1,1) + & 
     4993                  &   tl_lat1%d_value( il_iur1(1), & 
     4994                                     & il_iur1(2)+jj*id_rho(jp_J),1,1) ) 
     4995                   
     4996               ENDIF 
     4997 
     4998               ! assume there could be little difference due to interpolation 
     4999               IF( ABS(dl_lat1F - dl_lat0F) > dl_delta )THEN 
     5000                  ll_coincidence=.FALSE. 
     5001                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& 
     5002                  &  "i-direction refinement factor ("//& 
     5003                  &   TRIM(fct_str(id_rho(jp_I)))//& 
     5004                  &  ") between fine grid and coarse grid ") 
     5005               ENDIF 
     5006            ENDIF 
     5007 
     5008         ENDDO 
     5009      ENDIF 
    42835010 
    42845011      ! clean  
     
    48515578 
    48525579         ! copy structure 
    4853           tl_mpp=mpp_copy(td_mpp) 
    4854  
    4855           CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio))) 
    4856           IF( tl_mpp%i_perio < 0 )THEN 
    4857              ! compute NEMO periodicity index 
    4858              CALL grid_get_info(tl_mpp) 
    4859           ENDIF 
     5580         tl_mpp=mpp_copy(td_mpp) 
     5581 
     5582         CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio))) 
     5583         IF( tl_mpp%i_perio < 0 )THEN 
     5584            ! compute NEMO periodicity index 
     5585            CALL grid_get_info(tl_mpp) 
     5586         ENDIF 
    48605587 
    48615588         SELECT CASE(tl_mpp%i_perio) 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90

    r5616 r6392  
    627627       
    628628      IF( ld_even(jp_I) )THEN 
    629          dl_dx=1./REAL(id_rho(jp_I)-1) 
     629         dl_dx=1._dp/REAL(id_rho(jp_I)-1,dp) 
    630630      ELSE ! odd refinement 
    631          dl_dx=1./REAL(id_rho(jp_I)) 
     631         dl_dx=1._dp/REAL(id_rho(jp_I),dp) 
    632632      ENDIF 
    633633 
    634634      IF( ld_even(jp_J) )THEN 
    635          dl_dy=1./REAL(id_rho(jp_J)-1) 
     635         dl_dy=1._dp/REAL(id_rho(jp_J)-1,dp) 
    636636      ELSE ! odd refinement 
    637          dl_dy=1./REAL(id_rho(jp_J)) 
     637         dl_dy=1._dp/REAL(id_rho(jp_J),dp) 
    638638      ENDIF 
    639639 
     
    642642 
    643643         IF( ld_even(jp_J) )THEN 
    644             dl_y=(jj-1)*dl_dy - dl_dy*0.5  
     644            dl_y=REAL(jj-1,dp)*dl_dy - dl_dy*0.5_dp 
    645645         ELSE ! odd refinement 
    646             dl_y=(jj-1)*dl_dy  
     646            dl_y=REAL(jj-1,dp)*dl_dy  
    647647         ENDIF 
    648648 
     
    653653 
    654654            IF( ld_even(jp_I) )THEN 
    655                dl_x=(ji-1)*dl_dx - dl_dx*0.5  
     655               dl_x=REAL(ji-1,dp)*dl_dx - dl_dx*0.5_dp  
    656656            ELSE ! odd refinement 
    657                dl_x=(ji-1)*dl_dx  
     657               dl_x=REAL(ji-1,dp)*dl_dx  
    658658            ENDIF 
    659659 
     
    692692       
    693693      IF( ld_even )THEN 
    694          dl_dx=1./REAL(id_rho-1) 
     694         dl_dx=1._dp/REAL(id_rho-1,dp) 
    695695      ELSE ! odd refinement 
    696          dl_dx=1./REAL(id_rho) 
     696         dl_dx=1._dp/REAL(id_rho,dp) 
    697697      ENDIF 
    698698 
    699699      DO ji=1,id_rho+1 
    700700         IF( ld_even )THEN 
    701             dl_x=(ji-1)*dl_dx - dl_dx*0.5  
     701            dl_x=REAL(ji-1,dp)*dl_dx - dl_dx*0.5_dp  
    702702         ELSE ! odd refinement 
    703             dl_x=(ji-1)*dl_dx  
     703            dl_x=REAL(ji-1,dp)*dl_dx  
    704704         ENDIF 
    705705 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90

    r5616 r6392  
    214214            &                       cmode=NF90_64BIT_OFFSET,& 
    215215            &                       ncid=td_file%i_id) 
    216          !NF90_WRITE,               & 
    217216            CALL iom_cdf__check(il_status," IOM CDF CREATE: ") 
    218217 
     
    222221 
    223222      ELSE 
     223 
    224224         IF( td_file%i_id /= 0 )THEN 
    225225 
     
    239239               CALL iom_cdf__check(il_status," IOM CDF OPEN: ") 
    240240 
    241                CALL logger_trace("IOM CDF OPEN "//TRIM(td_file%c_name)//" "//& 
    242                   &  TRIM(fct_str(td_file%i_id))) 
    243241            ELSE 
    244242 
     
    363361      ! Argument       
    364362      TYPE(TFILE), INTENT(INOUT) :: td_file 
     363      ! local variable 
     364      TYPE(TDIM) :: tl_dim 
    365365 
    366366      ! loop indices 
    367367      INTEGER(i4) :: ji 
     368      INTEGER(i4) :: ii 
    368369      !---------------------------------------------------------------- 
    369370 
     
    374375 
    375376      IF( td_file%i_ndim > 0 )THEN 
     377         ii=1 
    376378         DO ji = 1, td_file%i_ndim 
    377379            ! read dimension information 
    378             td_file%t_dim(ji)=iom_cdf_read_dim( td_file, ji) 
     380            tl_dim=iom_cdf_read_dim( td_file, ji) 
     381            IF( .NOT. dim_is_dummy(tl_dim) )THEN 
     382               IF( ii > ip_maxdim )THEN 
     383                  CALL logger_fatal("IOM CDF OPEN: too much dimension "//& 
     384                  & "to be read. you should remove dummy dimension using "//& 
     385                  & " configuration file") 
     386               ENDIF 
     387               td_file%t_dim(ii)=dim_copy(tl_dim) 
     388               ii=ii+1 
     389            ENDIF 
    379390         ENDDO 
    380391 
     
    418429 
    419430      ! local variable 
     431      TYPE(TATT) :: tl_att 
     432 
    420433      ! loop indices 
    421434      INTEGER(i4) :: ji 
     435      INTEGER(i4) :: ii 
    422436      !---------------------------------------------------------------- 
    423437 
     
    429443         ALLOCATE(td_file%t_att(td_file%i_natt)) 
    430444 
     445         ii=1 
    431446         DO ji = 1, td_file%i_natt 
    432447            ! read global attribute 
    433             td_file%t_att(ji)=iom_cdf_read_att( td_file, NF90_GLOBAL, ji) 
     448            tl_att=iom_cdf_read_att( td_file, NF90_GLOBAL, ji) 
     449            IF( .NOT. att_is_dummy(tl_att) )THEN 
     450               td_file%t_att(ii)=att_copy(tl_att) 
     451               ii=ii+1 
     452            ENDIF 
    434453             
    435454         ENDDO 
     
    450469   !> @author J.Paul 
    451470   !> @date November, 2013 - Initial Version 
     471   !> @date September, 2015 
     472   !> - manage useless (dummy) variable 
     473   !> @date January, 2016 
     474   !> - increment n3d for 4D variable 
    452475   ! 
    453476   !> @param[inout] td_file   file structure 
     
    460483      ! local variable 
    461484      INTEGER(i4) :: il_attid 
     485      INTEGER(i4) :: il_nvar 
     486 
     487      TYPE(TVAR), DIMENSION(:), ALLOCATABLE  :: tl_var 
    462488 
    463489      ! loop indices 
    464490      INTEGER(i4) :: ji 
     491      INTEGER(i4) :: ii 
    465492      !---------------------------------------------------------------- 
    466493 
    467494      IF( td_file%i_nvar > 0 )THEN 
     495 
    468496         IF(ASSOCIATED(td_file%t_var))THEN 
    469497            CALL var_clean(td_file%t_var(:)) 
    470498            DEALLOCATE(td_file%t_var) 
    471499         ENDIF 
     500 
     501         il_nvar=td_file%i_nvar 
     502         ALLOCATE(tl_var(il_nvar)) 
     503         ii=0 
     504         DO ji = 1, il_nvar 
     505           ! read variable information 
     506           tl_var(ji)=iom_cdf__read_var_meta( td_file, ji)  
     507           IF( .NOT. var_is_dummy(tl_var(ji)) )THEN 
     508              ii=ii+1 
     509           ENDIF 
     510         ENDDO 
     511 
     512         ! update number of variable used 
     513         td_file%i_nvar=ii 
     514 
    472515         ALLOCATE(td_file%t_var(td_file%i_nvar)) 
    473516 
    474          DO ji = 1, td_file%i_nvar 
    475             ! read dimension information 
    476             td_file%t_var(ji)=iom_cdf__read_var_meta( td_file, ji) 
    477             SELECT CASE(td_file%t_var(ji)%i_ndim) 
    478                CASE(0) 
    479                   td_file%i_n0d=td_file%i_n0d+1 
    480                CASE(1) 
    481                   td_file%i_n1d=td_file%i_n1d+1 
    482                   td_file%i_rhd=td_file%i_rhd+1 
    483                CASE(2) 
    484                   td_file%i_n2d=td_file%i_n2d+1 
    485                   td_file%i_rhd=td_file%i_rhd+1 
    486                CASE(3) 
    487                   td_file%i_n3d=td_file%i_n3d+1 
    488                   td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len 
    489             END SELECT 
    490  
    491             ! look for depth id 
    492             IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'depth')/=0 )THEN 
    493                IF( td_file%i_depthid == 0 )THEN 
    494                   td_file%i_depthid=ji 
    495                ELSE 
    496                   IF( td_file%i_depthid /= ji )THEN 
    497                      CALL logger_error("IOM CDF GET FILE VAR: find more"//& 
    498                         &  " than one depth variable in file "//& 
    499                         &  TRIM(td_file%c_name) ) 
     517         ii=0 
     518         DO ji = 1, il_nvar 
     519            IF( .NOT. var_is_dummy(tl_var(ji)) )THEN 
     520               ii=ii+1 
     521               td_file%t_var(ii)=var_copy(tl_var(ji)) 
     522               SELECT CASE(td_file%t_var(ii)%i_ndim) 
     523                  CASE(0) 
     524                     td_file%i_n0d=td_file%i_n0d+1 
     525                  CASE(1) 
     526                     td_file%i_n1d=td_file%i_n1d+1 
     527                     td_file%i_rhd=td_file%i_rhd+1 
     528                  CASE(2) 
     529                     td_file%i_n2d=td_file%i_n2d+1 
     530                     td_file%i_rhd=td_file%i_rhd+1 
     531                  CASE(3,4) 
     532                     td_file%i_n3d=td_file%i_n3d+1 
     533                     td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len 
     534               END SELECT 
     535 
     536               ! look for depth id 
     537               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'depth')/=0 )THEN 
     538                  IF( td_file%i_depthid == 0 )THEN 
     539                     td_file%i_depthid=ji 
     540                  ELSE 
     541                     IF( td_file%i_depthid /= ji )THEN 
     542                        CALL logger_error("IOM CDF GET FILE VAR: find more"//& 
     543                           &  " than one depth variable in file "//& 
     544                           &  TRIM(td_file%c_name) ) 
     545                     ENDIF 
    500546                  ENDIF 
    501547               ENDIF 
    502             ENDIF 
    503  
    504             ! look for time id 
    505             IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'time')/=0 )THEN 
    506                IF( td_file%i_timeid == 0 )THEN 
    507                   td_file%i_timeid=ji 
    508                ELSE 
    509                   il_attid=0 
    510                   IF( ASSOCIATED(td_file%t_var(ji)%t_att) )THEN 
    511                      il_attid=att_get_id(td_file%t_var(ji)%t_att(:),'calendar') 
    512                   ENDIF 
    513                   IF( il_attid /= 0 )THEN 
     548 
     549               ! look for time id 
     550               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'time')/=0 )THEN 
     551                  IF( td_file%i_timeid == 0 )THEN 
    514552                     td_file%i_timeid=ji 
    515                   !ELSE 
    516                   !   CALL logger_error("IOM CDF GET FILE VAR: find more "//& 
    517                   !   &                 "than one time variable in file "//& 
    518                   !   &                 TRIM(td_file%c_name) ) 
     553                  ELSE 
     554                     il_attid=0 
     555                     IF( ASSOCIATED(td_file%t_var(ii)%t_att) )THEN 
     556                        il_attid=att_get_id(td_file%t_var(ii)%t_att(:),'calendar') 
     557                     ENDIF 
     558                     IF( il_attid /= 0 )THEN 
     559                        td_file%i_timeid=ji 
     560                     !ELSE 
     561                     !   CALL logger_error("IOM CDF GET FILE VAR: find more "//& 
     562                     !   &                 "than one time variable in file "//& 
     563                     !   &                 TRIM(td_file%c_name) ) 
     564                     ENDIF 
    519565                  ENDIF 
    520566               ENDIF 
     567 
    521568            ENDIF 
    522  
    523569         ENDDO 
     570 
     571         CALL var_clean(tl_var(:)) 
     572         DEALLOCATE(tl_var) 
    524573 
    525574      ELSE 
     
    605654      ELSE       
    606655 
    607          iom_cdf__read_dim_id%i_id=id_dimid 
    608  
    609656         CALL logger_trace( & 
    610657         &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//& 
     
    627674      ENDIF 
    628675 
     676      iom_cdf__read_dim_id%i_id=id_dimid 
     677 
    629678   END FUNCTION iom_cdf__read_dim_id 
    630679   !------------------------------------------------------------------- 
     
    748797               IF( LEN(cl_value) < il_len )THEN 
    749798 
    750                   CALL logger_error( & 
     799                  CALL logger_warn( & 
    751800                  &  " IOM CDF READ ATT: not enough space to put "//& 
    752801                  &  "attribute "//TRIM(cl_name) ) 
     
    12231272   !> @date September, 2014 
    12241273   !> - force to use FillValue=1.e20 if no FillValue for coordinate variable. 
     1274   !> @date September, 2015 
     1275   !> - manage useless (dummy) attribute 
    12251276   ! 
    12261277   !> @param[in] td_file   file structure 
     
    12501301 
    12511302      ! loop indices 
     1303      INTEGER(i4) :: ji 
    12521304      !---------------------------------------------------------------- 
    12531305      ! check if file opened 
     
    12751327         &                                il_natt ) 
    12761328         CALL iom_cdf__check(il_status,"IOM CDF READ VAR META: ") 
     1329 
    12771330         !!! fill variable dimension structure 
    1278          tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, il_dimid(:) ) 
     1331         tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, cl_name, il_dimid(:) ) 
    12791332 
    12801333         IF( il_natt /= 0 )THEN 
     
    13531406         &                                tl_att(:), id_id=id_varid ) 
    13541407 
     1408         !! look for dummy attribute 
     1409         DO ji=il_natt,1,-1 
     1410            IF( att_is_dummy(tl_att(ji)) )THEN 
     1411               CALL var_del_att(iom_cdf__read_var_meta, tl_att(ji)) 
     1412            ENDIF 
     1413         ENDDO 
     1414 
    13551415         ! clean 
    13561416         CALL dim_clean(tl_dim(:)) 
     
    13731433   !> So the array of dimension structure of a variable is always compose of 4 
    13741434   !> dimension (use or not).  
    1375    ! 
     1435   !> 
     1436   !> @warn dummy dimension are not used.  
     1437   !> 
    13761438   !> @author J.Paul 
    13771439   !> @date November, 2013 - Initial Version 
    13781440   !> @date July, 2015  
    13791441   !> - Bug fix: use order to disorder table (see dim_init) 
     1442   !> @date September, 2015 
     1443   !> - check dummy dimension 
    13801444   !> 
    13811445   !> @param[in] td_file   file structure 
    13821446   !> @param[in] id_ndim   number of dimension 
     1447   !> @param[in] cd_name   variable name 
    13831448   !> @param[in] id_dimid  array of dimension id 
    13841449   !> @return array dimension structure  
    13851450   !------------------------------------------------------------------- 
    1386    FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, id_dimid) 
     1451   FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, cd_name, id_dimid) 
    13871452      IMPLICIT NONE 
    13881453      ! Argument       
    13891454      TYPE(TFILE),               INTENT(IN) :: td_file 
    13901455      INTEGER(i4),               INTENT(IN) :: id_ndim 
     1456      CHARACTER(LEN=*)         , INTENT(IN) :: cd_name 
    13911457      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_dimid 
    13921458 
     
    14011467      ! loop indices 
    14021468      INTEGER(i4) :: ji 
     1469      INTEGER(i4) :: ii 
    14031470      !---------------------------------------------------------------- 
    14041471 
     
    14151482         CALL dim_clean(tl_dim(:)) 
    14161483 
    1417       ELSE IF( id_ndim > 0 .AND. id_ndim <= 4 )THEN 
    1418  
    1419  
     1484      ELSE IF( id_ndim > 0 )THEN 
     1485 
     1486 
     1487         ii=1 
    14201488         DO ji = 1, id_ndim 
    1421             CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//& 
    1422                &  "dimension "//TRIM(fct_str(ji)) ) 
    1423  
    1424             il_xyzt2(ji)=td_file%t_dim(id_dimid(ji))%i_xyzt2 
    1425  
    1426             ! read dimension information 
    1427             tl_dim(ji) = dim_init( td_file%t_dim(il_xyzt2(ji))%c_name, & 
    1428             &                      td_file%t_dim(il_xyzt2(ji))%i_len ) 
     1489 
     1490            !!! check no dummy dimension to be used 
     1491            IF( ANY(td_file%t_dim(:)%i_id == id_dimid(ji)) )THEN 
     1492               IF( ii > ip_maxdim )THEN 
     1493                  CALL logger_error(" IOM CDF READ VAR DIM: "//& 
     1494                  &  "too much dimensions for variable "//& 
     1495                  &  TRIM(cd_name)//". check dummy configuration file.") 
     1496               ENDIF 
     1497 
     1498               CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//& 
     1499                  &  "dimension "//TRIM(fct_str(ji)) ) 
     1500 
     1501               il_xyzt2(ii)=td_file%t_dim(id_dimid(ji))%i_xyzt2 
     1502 
     1503               ! read dimension information 
     1504               tl_dim(ii) = dim_init( td_file%t_dim(il_xyzt2(ii))%c_name, & 
     1505               &                      td_file%t_dim(il_xyzt2(ii))%i_len ) 
     1506             
     1507               ii=ii+1 
     1508            ELSE 
     1509               CALL logger_debug( " IOM CDF READ VAR DIM: dummy variable "//& 
     1510               &  "dimension "//TRIM(fct_str(ji))//" not used." ) 
     1511            ENDIF 
    14291512         ENDDO 
    14301513 
     
    14361519         ! clean 
    14371520         CALL dim_clean(tl_dim(:)) 
    1438  
    1439       ELSE 
    1440  
    1441          CALL logger_error(" IOM CDF READ VAR DIM: can't manage "//& 
    1442          &              TRIM(fct_str(id_ndim))//" dimension(s)" ) 
    14431521 
    14441522      ENDIF 
     
    19432021   !> @author J.Paul 
    19442022   !> @date November, 2013 - Initial Version 
     2023   !> @date September, 2015 
     2024   !> - do not force to use zero as FillValue for any meshmask variable 
    19452025   ! 
    19462026   !> @param[inout] td_file   file structure 
     
    19762056      ! check if file and variable dimension conform 
    19772057      IF( file_check_var_dim(td_file, td_var) )THEN 
    1978  
    1979          ! check variable dimension expected 
    1980          CALL var_check_dim(td_var) 
    19812058 
    19822059         ll_chg=.TRUE. 
     
    19982075               CASE('nav_lon','nav_lat', & 
    19992076                  & 'glamt','glamu','glamv','glamf', & 
    2000                   & 'gphit','gphiu','gphiv','gphif') 
     2077                  & 'gphit','gphiu','gphiv','gphif', & 
     2078                  & 'e1t','e1u','e1v','e1f',         & 
     2079                  & 'e2t','e2u','e2v','e2f','ff',    & 
     2080                  & 'gcost','gcosu','gcosv','gcosf', & 
     2081                  & 'gsint','gsinu','gsinv','gsinf', & 
     2082                  & 'mbathy','misf','isf_draft',     & 
     2083                  & 'hbatt','hbatu','hbatv','hbatf', & 
     2084                  & 'gsigt','gsigu','gsigv','gsigf', & 
     2085                  & 'e3t_0','e3u_0','e3v_0','e3w_0', & 
     2086                  & 'e3f_0','gdepw_1d','gdept_1d',   & 
     2087                  & 'e3tp','e3wp','gdepw_0','rx1',   & 
     2088                  & 'gdept_0','gdepu','gdepv',       & 
     2089                  & 'hdept','hdepw','e3w_1d','e3t_1d',& 
     2090                  & 'tmask','umask','vmask','fmask'  ) 
     2091                  ! do not change for coordinates and meshmask variables 
    20012092            END SELECT 
    20022093         ENDIF 
     
    21182209         ENDIF 
    21192210 
    2120          IF( tl_var%t_att(ji)%i_type == NF90_CHAR )THEN 
    2121             IF( TRIM(tl_var%t_att(ji)%c_value) /= '' )THEN 
    2122                il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, & 
    2123                &                        TRIM(tl_var%t_att(ji)%c_name),        & 
    2124                &                        TRIM(tl_var%t_att(ji)%c_value)        ) 
    2125                CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
    2126             ENDIF 
    2127          ELSE 
    2128             SELECT CASE(tl_var%t_att(ji)%i_type) 
    2129                CASE(NF90_BYTE) 
    2130                   il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    2131                   &                        iom_cdf__write_var_def,         & 
    2132                   &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    2133                   &                        INT(tl_var%t_att(ji)%d_value(:),i1)) 
    2134                CASE(NF90_SHORT) 
    2135                   il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    2136                   &                        iom_cdf__write_var_def,         & 
    2137                   &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    2138                   &                        INT(tl_var%t_att(ji)%d_value(:),i2)) 
    2139                CASE(NF90_INT) 
    2140                   il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    2141                   &                        iom_cdf__write_var_def,         & 
    2142                   &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    2143                   &                        INT(tl_var%t_att(ji)%d_value(:),i4)) 
    2144                CASE(NF90_FLOAT) 
    2145                   il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    2146                   &                        iom_cdf__write_var_def,         & 
    2147                   &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    2148                   &                        REAL(tl_var%t_att(ji)%d_value(:),sp)) 
    2149                CASE(NF90_DOUBLE) 
    2150                   il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    2151                   &                        iom_cdf__write_var_def,         & 
    2152                   &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    2153                   &                        REAL(tl_var%t_att(ji)%d_value(:),dp)) 
    2154             END SELECT 
    2155             CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
    2156          ENDIF 
     2211         SELECT CASE(tl_var%t_att(ji)%i_type) 
     2212            CASE(NF90_CHAR) 
     2213               IF( TRIM(tl_var%t_att(ji)%c_value) /= '' )THEN 
     2214                  il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, & 
     2215                  &                        TRIM(tl_var%t_att(ji)%c_name),        & 
     2216                  &                        TRIM(tl_var%t_att(ji)%c_value)        ) 
     2217               ENDIF 
     2218            CASE(NF90_BYTE) 
     2219               il_status = NF90_PUT_ATT(td_file%i_id,                   & 
     2220               &                        iom_cdf__write_var_def,         & 
     2221               &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2222               &                        INT(tl_var%t_att(ji)%d_value(:),i1)) 
     2223            CASE(NF90_SHORT) 
     2224               il_status = NF90_PUT_ATT(td_file%i_id,                   & 
     2225               &                        iom_cdf__write_var_def,         & 
     2226               &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2227               &                        INT(tl_var%t_att(ji)%d_value(:),i2)) 
     2228            CASE(NF90_INT) 
     2229               il_status = NF90_PUT_ATT(td_file%i_id,                   & 
     2230               &                        iom_cdf__write_var_def,         & 
     2231               &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2232               &                        INT(tl_var%t_att(ji)%d_value(:),i4)) 
     2233            CASE(NF90_FLOAT) 
     2234               il_status = NF90_PUT_ATT(td_file%i_id,                   & 
     2235               &                        iom_cdf__write_var_def,         & 
     2236               &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2237               &                        REAL(tl_var%t_att(ji)%d_value(:),sp)) 
     2238            CASE(NF90_DOUBLE) 
     2239               il_status = NF90_PUT_ATT(td_file%i_id,                   & 
     2240               &                        iom_cdf__write_var_def,         & 
     2241               &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2242               &                        REAL(tl_var%t_att(ji)%d_value(:),dp)) 
     2243         END SELECT 
     2244         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
     2245 
    21572246      ENDDO 
    21582247 
     
    22002289         &  (td_var%d_value(:,:,:,:)-td_var%d_ofs)/td_var%d_scf 
    22012290      END WHERE 
    2202        
     2291 
    22032292      jj=0 
    22042293      DO ji = 1, ip_maxdim 
     
    22262315 
    22272316      ! put value 
    2228       CALL logger_trace( & 
     2317      CALL logger_debug( & 
    22292318      &  "IOM CDF WRITE VAR VALUE: put "//TRIM(td_var%c_name)//" value "//& 
    22302319      &  "in file "//TRIM(td_file%c_name)) 
    22312320 
    22322321      il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:)) 
    2233       CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE: ") 
     2322      CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE ("//& 
     2323         &  TRIM(td_var%c_name)//") :" ) 
    22342324 
    22352325      DEALLOCATE( dl_value ) 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90

    r5616 r6392  
    234234               CALL logger_error( & 
    235235               &  " IOM DOM READ VAR: there is no variable with "//& 
    236                &  "name or standard name"//TRIM(cd_name)//& 
     236               &  "name or standard name "//TRIM(cd_name)//& 
    237237               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name)) 
    238238            ENDIF 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90

    r5616 r6392  
    415415            ELSE 
    416416 
    417                CALL logger_error( & 
     417               CALL logger_fatal( & 
    418418               &  " IOM MPP READ VAR: there is no variable with "//& 
    419419               &  "name or standard name "//TRIM(cd_name)//& 
     
    648648         DO ji=1, td_mpp%i_nproc 
    649649            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
    650                !CALL file_del_att(td_mpp%t_proc(ji), 'periodicity') 
    651                !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap') 
    652  
    653650               CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder) 
    654651            ELSE 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90

    r5616 r6392  
    395395   !> @author J.Paul 
    396396   !> @date November, 2013 - Initial Version 
    397    ! 
     397   !> @date January, 2016 
     398   !> - mismatch with "halo" indices 
     399   !> 
    398400   !> @param[inout] td_file   file structure 
    399401   !------------------------------------------------------------------- 
     
    494496      ENDIF 
    495497 
    496       tl_att=att_init( "DOMAIN_position_first", (/il_impp(il_area), il_jmpp(il_area)/)) 
     498      tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", il_impp(:) ) 
    497499      CALL file_move_att(td_file, tl_att) 
    498  
    499       tl_att=att_init( "DOMAIN_position_last", (/il_lci(il_area), il_lcj(il_area)/)) 
     500      tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", il_jmpp(:) ) 
    500501      CALL file_move_att(td_file, tl_att) 
    501502 
    502       tl_att=att_init( "DOMAIN_halo_size_start", (/il_ldi(il_area), il_ldj(il_area)/)) 
     503      tl_att=att_init( "SUBDOMAIN_I_dimensions", il_lci(:)) 
    503504      CALL file_move_att(td_file, tl_att) 
    504  
    505       tl_att=att_init( "DOMAIN_halo_size_end", (/il_lei(il_area), il_lej(il_area)/)) 
     505      tl_att=att_init( "SUBDOMAIN_J_dimensions", il_lcj(:)) 
    506506      CALL file_move_att(td_file, tl_att) 
    507507 
    508       tl_att=att_init( "DOMAIN_I_position_first", il_impp(:) ) 
     508      tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", il_ldi(:)) 
    509509      CALL file_move_att(td_file, tl_att) 
    510       tl_att=att_init( "DOMAIN_J_position_first", il_jmpp(:) ) 
     510      tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", il_ldj(:)) 
    511511      CALL file_move_att(td_file, tl_att) 
    512512 
    513       tl_att=att_init( "DOMAIN_I_position_last", il_lci(:) ) 
     513      tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", il_lei(:)) 
    514514      CALL file_move_att(td_file, tl_att) 
    515       tl_att=att_init( "DOMAIN_J_position_last", il_lcj(:) ) 
    516       CALL file_move_att(td_file, tl_att) 
    517  
    518       tl_att=att_init( "DOMAIN_I_halo_size_start", il_ldi(:) ) 
    519       CALL file_move_att(td_file, tl_att) 
    520       tl_att=att_init( "DOMAIN_J_halo_size_start", il_ldj(:) ) 
    521       CALL file_move_att(td_file, tl_att) 
    522  
    523       tl_att=att_init( "DOMAIN_I_halo_size_end", il_lei(:) ) 
    524       CALL file_move_att(td_file, tl_att) 
    525       tl_att=att_init( "DOMAIN_J_halo_size_end", il_lej(:) ) 
     515      tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", il_lej(:)) 
    526516      CALL file_move_att(td_file, tl_att) 
    527517 
     
    10381028   !> @author J.Paul 
    10391029   !> @date November, 2013 - Initial Version 
     1030   !> @date February, 2016 
     1031   !> - use temporary array to read value from file 
    10401032   ! 
    10411033   !> @param[in] td_file   file structure 
     
    10591051      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_count 
    10601052 
     1053      REAL(dp),    DIMENSION(:,:,:)  , ALLOCATABLE :: dl_tmp 
    10611054      REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 
    10621055 
     
    11421135         IF( ALL(td_var%t_dim(1:3)%l_use) )THEN 
    11431136            ! 3D variable (X,Y,Z) 
     1137            ALLOCATE(dl_tmp( td_var%t_dim(1)%i_len, & 
     1138            &                td_var%t_dim(2)%i_len, & 
     1139            &                td_var%t_dim(4)%i_len) )            
    11441140            DO ji=1,td_var%t_dim(3)%i_len 
    11451141               READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec +ji-1) & 
    1146                &  dl_value(:,:,ji,:) 
     1142               &  dl_tmp(:,:,:) 
    11471143               CALL fct_err(il_status) 
    11481144               IF( il_status /= 0 )THEN 
     
    11501146                  &              TRIM(td_var%c_name)) 
    11511147               ENDIF 
     1148               dl_value(:,:,ji,:)=dl_tmp(:,:,:) 
    11521149            ENDDO 
     1150            DEALLOCATE(dl_tmp) 
    11531151         ELSEIF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
    11541152            ! 2D variable (X,Y) 
     
    14271425   !> @author J.Paul 
    14281426   !> @date November, 2013 - Initial Version 
    1429    ! 
     1427   !> @date January, 2016 
     1428   !> - mismatch with "halo" indices 
     1429   !> 
    14301430   !> @param[inout] td_file   file structure 
    14311431   !------------------------------------------------------------------- 
     
    15421542      &         il_lei(il_nproc),  il_lej(il_nproc) ) 
    15431543 
    1544       ! get domain first poistion 
    1545       il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_first" ) 
     1544      ! get left bottom indices 
     1545      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_left_bottom_indices" ) 
    15461546      il_impp(:) = 0 
    15471547      IF( il_ind /= 0 )THEN 
     
    15491549      ENDIF 
    15501550 
    1551       il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_first" ) 
     1551      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_left_bottom_indices" ) 
    15521552      il_jmpp(:) = 0 
    15531553      IF( il_ind /= 0 )THEN 
     
    15551555      ENDIF 
    15561556       
    1557       ! check domain first poistion 
     1557      ! check left bottom indices 
    15581558      IF( ANY(il_impp(:)==0) .OR. ANY(il_jmpp(:)==0) )THEN 
    1559          CALL logger_warn("WRITE FILE: no data for domain first position") 
    1560       ENDIF 
    1561  
    1562       ! get domain last poistion 
    1563       il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_last" ) 
     1559         CALL logger_warn("WRITE FILE: no data for subdomain left bottom indices") 
     1560      ENDIF 
     1561 
     1562      ! get subdomain dimensions 
     1563      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_dimensions" ) 
    15641564      il_lci(:) = 0 
    15651565      IF( il_ind /= 0 )THEN 
     
    15671567      ENDIF 
    15681568 
    1569       il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_last" ) 
     1569      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_dimensions" ) 
    15701570      il_lcj(:) = 0 
    15711571      IF( il_ind /= 0 )THEN 
     
    15731573      ENDIF 
    15741574 
    1575       ! check domain last poistion 
     1575      ! check subdomain dimension 
    15761576      IF( ANY(il_lci(:)==0) .OR. ANY(il_lcj(:)==0) )THEN 
    1577          CALL logger_warn("WRITE FILE: no data for domain last position") 
    1578       ENDIF 
    1579  
    1580       ! get halo size start 
    1581       il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_start" ) 
     1577         CALL logger_warn("WRITE FILE: no data for subdomain dimensions") 
     1578      ENDIF 
     1579 
     1580      ! get first indoor indices 
     1581      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_first_indoor_indices" ) 
    15821582      il_ldi(:) = 0 
    15831583      IF( il_ind /= 0 )THEN 
     
    15851585      ENDIF 
    15861586 
    1587       il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_start" ) 
     1587      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_first_indoor_indices" ) 
    15881588      il_ldj(:) = 0 
    15891589      IF( il_ind /= 0 )THEN 
     
    15911591      ENDIF 
    15921592       
    1593       ! check halo size start 
     1593      ! check first indoor indices 
    15941594      IF( ANY(il_ldi(:)==0) .OR. ANY(il_ldj(:)==0) )THEN 
    1595          CALL logger_warn("WRITE FILE: no data for halo size start") 
    1596       ENDIF 
    1597  
    1598       ! get halo size end 
    1599       il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_end" ) 
     1595         CALL logger_warn("WRITE FILE: no data for subdomain first indoor indices") 
     1596      ENDIF 
     1597 
     1598      ! get last indoor indices 
     1599      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_last_indoor_indices" ) 
    16001600      il_lei(:) = 0 
    16011601      IF( il_ind /= 0 )THEN 
     
    16031603      ENDIF 
    16041604 
    1605       il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_end" ) 
     1605      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_last_indoor_indices" ) 
    16061606      il_lej(:) = 0 
    16071607      IF( il_ind /= 0 )THEN 
     
    16091609      ENDIF 
    16101610 
    1611       ! check halo size end 
     1611      ! check last indoor indices 
    16121612      IF( ANY(il_lei(:)==0) .OR. ANY(il_lej(:)==0) )THEN 
    1613          CALL logger_warn("WRITE FILE: no data for halo size end") 
     1613         CALL logger_warn("WRITE FILE: no data for subdomain last indoor indices") 
    16141614      ENDIF       
    16151615 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/logger.f90

    r5616 r6392  
    66! 
    77! DESCRIPTION: 
    8 !> @brief This module create logger file and allow to fill it depending of verbosity. 
     8!> @brief This module manage log file. 
    99!> @details 
     10!> This module create log file and fill it depending of verbosity. 
     11!> 
    1012!> verbosity could be choosen between : 
    1113!>    - trace : Most detailed information. 
     
    1719!>    - error : Other runtime errors or unexpected conditions. 
    1820!>    - fatal : Severe errors that cause premature termination. 
    19 !>  default verbosity is warning 
    2021!>    - none  : to not create and write any information in logger file.<br /> 
    21 ! 
     22!>       @warn in this case only FATAL ERROR will be detected.<br /> 
     23!> 
     24!> @note default verbosity is warning 
     25!> 
    2226!> If total number of error exceeded maximum number  
    2327!> authorized, program stop. 
     
    3539!> @code 
    3640!> CALL logger_close() 
     41!> @endcode 
     42!> 
     43!> to clean logger file:<br/> 
     44!> @code 
     45!> CALL logger_clean() 
    3746!> @endcode 
    3847!> 
     
    104113!>   CALL logger_footer() 
    105114!>   CALL logger_close() 
     115!>   CALL logger_clean() 
    106116!> @endcode 
    107117!> 
     
    116126!>   CALL logger_footer() 
    117127!>   CALL logger_close() 
     128!>   CALL logger_clean() 
    118129!> @endcode 
    119130! 
     
    125136!> - check verbosity validity 
    126137!> - add 'none' verbosity level to not used logger file 
     138!> @date January, 2016 
     139!> - add logger_clean subroutine 
    127140!> 
    128141!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    144157   PUBLIC :: logger_open        !< create a log file with given verbosity 
    145158   PUBLIC :: logger_close       !< close log file 
     159   PUBLIC :: logger_clean       !< clean log structure 
    146160   PUBLIC :: logger_header      !< write header on log file 
    147161   PUBLIC :: logger_footer      !< write footer on log file 
     
    273287      IMPLICIT NONE 
    274288      ! local variable 
    275       INTEGER(i4) :: il_status 
    276       !---------------------------------------------------------------- 
    277       IF( tm_logger%l_use )THEN 
    278          IF( tm_logger%i_id /= 0 )THEN 
    279             tm_logger%i_id = 0 
     289      INTEGER(i4)   :: il_status 
     290      !---------------------------------------------------------------- 
     291      IF( tm_logger%l_use )THEN 
     292         IF( tm_logger%i_id /= 0 )THEN 
     293            !tm_logger%i_id = 0 
    280294            CLOSE( tm_logger%i_id, & 
    281295            &      IOSTAT=il_status)       
     
    289303 
    290304   END SUBROUTINE logger_close 
     305   !------------------------------------------------------------------- 
     306   !> @brief This subroutine clean a log structure. 
     307   !> 
     308   !> @author J.Paul 
     309   !> @date January, 2016 - Initial Version 
     310   !------------------------------------------------------------------- 
     311   SUBROUTINE logger_clean() 
     312      IMPLICIT NONE 
     313      ! local variable 
     314      TYPE(TLOGGER) :: tl_logger 
     315      !---------------------------------------------------------------- 
     316      tm_logger = tl_logger 
     317 
     318   END SUBROUTINE logger_clean 
    291319   !------------------------------------------------------------------- 
    292320   !> @brief This subroutine flushing output into log file. 
     
    537565      IF( tm_logger%l_use )THEN 
    538566         IF( tm_logger%i_id /= 0 )THEN 
    539             IF( TRIM(tm_logger%c_verb) /= 'none' )THEN 
    540                ! increment the error number 
    541                tm_logger%i_nerror=tm_logger%i_nerror+1 
    542             ENDIF 
     567            ! increment the error number 
     568            tm_logger%i_nerror=tm_logger%i_nerror+1 
    543569 
    544570            IF( INDEX(TRIM(tm_logger%c_verb),'error')/=0 )THEN 
     
    571597   !> @author J.Paul 
    572598   !> @date November, 2013 - Initial Version 
     599   !> @date September, 2015 
     600   !> - stop program for FATAL ERROR if verbosity is none 
    573601   ! 
    574602   !> @param[in] cd_msg message to write 
     
    598626             CALL logger_fatal('you must have create logger to use logger_fatal') 
    599627         ENDIF 
     628      ELSE 
     629         PRINT *,"FATAL ERROR :"//TRIM(cd_msg) 
     630         STOP 
    600631      ENDIF 
    601632   END SUBROUTINE logger_fatal 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/math.f90

    r5616 r6392  
    12241224          
    12251225      CASE('K') 
     1226 
     1227         ALLOCATE( dl_value(il_shape(1),il_shape(2),3) ) 
    12261228         ! compute derivative in k-direction 
    12271229         DO jk=1,il_shape(3) 
     
    12661268            ENDIF          
    12671269 
    1268             WHERE( dl_value(:,:, 2) /= dd_fill .AND. & ! jk 
    1269                &   dl_value(:,:, 3) /= dd_fill .AND. & ! jk+1 
    1270                &   dl_value(:,:, 1) /= dd_fill )       ! jk-1 
     1270            WHERE( dl_value(:,:,2) /= dd_fill .AND. & ! jk 
     1271               &   dl_value(:,:,3) /= dd_fill .AND. & ! jk+1 
     1272               &   dl_value(:,:,1) /= dd_fill )       ! jk-1 
    12711273 
    12721274               math_deriv_3D(:,:,jk)=& 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90

    r5608 r6392  
    99!> @file 
    1010!> @brief  
    11 !> This program merge bathymetry file at boundaries. 
     11!> This program merges bathymetry file at boundaries. 
    1212!> 
    1313!> @details 
    1414!> @section sec1 method 
    15 !> Coarse grid Bathymetry is interpolated on fine grid.  
     15!> Coarse grid Bathymetry is interpolated on fine grid  
     16!> (nearest interpolation method is used).   
    1617!> Then fine Bathymetry and refined coarse bathymetry are merged at boundaries.<br/> 
    1718!>    @f[BathyFine= Weight * BathyCoarse + (1-Weight)*BathyFine@f] 
     
    3132!>    you could find a template of the namelist in templates directory. 
    3233!> 
    33 !>    merge_bathy.nam comprise 8 namelists: 
     34!>    merge_bathy.nam contains 7 namelists: 
    3435!>       - logger namelist (namlog) 
    3536!>       - config namelist (namcfg) 
    3637!>       - coarse grid namelist (namcrs) 
    3738!>       - fine grid namelist (namfin) 
    38 !>       - variable namelist (namvar) 
     39!       - variable namelist (namvar) 
    3940!>       - nesting namelist (namnst) 
    4041!>       - boundary namelist (nambdy) 
    4142!>       - output namelist (namout) 
    4243!>  
    43 !>    @note  
    44 !>       All namelists have to be in file merge_bathy.nam,  
    45 !>       however variables of those namelists are all optional. 
    46 !> 
    4744!>    * _logger namelist (namlog)_: 
    4845!>       - cn_logfile   : logger filename 
     
    5249!> 
    5350!>    * _config namelist (namcfg)_: 
    54 !>       - cn_varcfg : variable configuration file (see ./SIREN/cfg/variable.cfg) 
     51!>       - cn_varcfg : variable configuration file  
     52!> (see ./SIREN/cfg/variable.cfg) 
     53!>       - cn_dumcfg : useless (dummy) configuration file, for useless  
     54!> dimension or variable (see ./SIREN/cfg/dummy.cfg). 
    5555!> 
    5656!>    * _coarse grid namelist (namcrs)_: 
     
    6363!>       - in_perio1 : NEMO periodicity index 
    6464!> 
    65 !>    * _variable namelist (namvar)_: 
    66 !>       - cn_varinfo : list of variable and extra information about request(s)  
    67 !>       to be used (separated by ',').<br/> 
    68 !>          each elements of *cn_varinfo* is a string character.<br/> 
    69 !>          it is composed of the variable name follow by ':',  
    70 !>          then request(s) to be used on this variable.<br/>  
    71 !>          request could be: 
    72 !>             - int = interpolation method 
    73 !>  
    74 !>                requests must be separated by ';'.<br/> 
    75 !>                order of requests does not matter.<br/> 
    76 !> 
    77 !>          informations about available method could be find in  
    78 !>          @ref interp modules.<br/> 
    79 !>          Example: 'bathymetry: int=cubic' 
    80 !>          @note  
    81 !>             If you do not specify a method which is required,  
    82 !>             default one is apply. 
    83 !>          @warning  
    84 !>             variable name must be __Bathymetry__ here. 
     65!    * _variable namelist (namvar)_: 
     66!       - cn_varinfo : list of variable and extra information about request(s)  
     67!       to be used (separated by ',').<br/> 
     68!          each elements of *cn_varinfo* is a string character.<br/> 
     69!          it is composed of the variable name follow by ':',  
     70!          then request(s) to be used on this variable.<br/>  
     71!          request could be: 
     72!             - int = interpolation method 
     73!  
     74!                requests must be separated by ';'.<br/> 
     75!                order of requests does not matter.<br/> 
     76! 
     77!          informations about available method could be find in  
     78!          @ref interp modules.<br/> 
     79!          Example: 'bathymetry: int=cubic' 
     80!          @note  
     81!             If you do not specify a method which is required,  
     82!             default one is apply. 
     83!          @warning  
     84!             variable name must be __Bathymetry__ here. 
    8585!> 
    8686!>    * _nesting namelist (namnst)_: 
     
    128128!> - extrapolate all land points 
    129129!> - add attributes with boundary string character (as in namelist) 
     130!> @date September, 2015 
     131!> - manage useless (dummy) variable, attributes, and dimension 
    130132!> 
    131133!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    207209   ! namcfg 
    208210   CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg'  
     211   CHARACTER(LEN=lc)                       :: cn_dumcfg = 'dummy.cfg' 
    209212 
    210213   ! namcrs 
     
    216219   INTEGER(i4)                             :: in_perio1 = -1 
    217220 
    218    ! namvar 
    219    CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
     221!   ! namvar 
     222!   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
    220223 
    221224   ! namnst 
     
    244247 
    245248   NAMELIST /namcfg/ &  !< config namelist 
    246    &  cn_varcfg         !< variable configuration file 
     249   &  cn_varcfg, &       !< variable configuration file 
     250   &  cn_dumcfg          !< dummy configuration file 
    247251 
    248252   NAMELIST /namcrs/ &  !< coarse grid namelist 
     
    254258   &  in_perio1         !< periodicity index 
    255259  
    256    NAMELIST /namvar/ &  !< variable namelist 
    257    &  cn_varinfo        !< list of variable and interpolation  
    258                         !< method to be used.  
    259                         !< (ex: 'votemper|linear','vosaline|cubic' )  
     260!   NAMELIST /namvar/ &  !< variable namelist 
     261!   &  cn_varinfo        !< list of variable and interpolation  
     262!                        !< method to be used.  
     263!                        !< (ex: 'votemper|linear','vosaline|cubic' )  
    260264    
    261265   NAMELIST /namnst/ &  !< nesting namelist 
     
    315319      CALL var_def_extra(TRIM(cn_varcfg)) 
    316320 
     321      ! get dummy variable 
     322      CALL var_get_dummy(TRIM(cn_dumcfg)) 
     323      ! get dummy dimension 
     324      CALL dim_get_dummy(TRIM(cn_dumcfg)) 
     325      ! get dummy attribute 
     326      CALL att_get_dummy(TRIM(cn_dumcfg)) 
     327 
    317328      READ( il_fileid, NML = namcrs ) 
    318329      READ( il_fileid, NML = namfin ) 
    319       READ( il_fileid, NML = namvar ) 
    320       ! add user change in extra information 
    321       CALL var_chg_extra(cn_varinfo) 
     330!      READ( il_fileid, NML = namvar ) 
     331!      ! add user change in extra information 
     332!      CALL var_chg_extra(cn_varinfo) 
    322333 
    323334      READ( il_fileid, NML = namnst ) 
     
    630641   !> @param[inout] dd_weight    array of weight 
    631642   !> @param[in] dd_fill         fillValue 
     643   !> 
     644   !> @todo improve boundary weight function 
    632645   !------------------------------------------------------------------- 
    633646   SUBROUTINE merge_bathy_get_boundary( td_bathy0, td_bathy1, td_bdy, & 
     
    690703               il_jmax1=td_bdy%t_seg(jl)%i_index 
    691704 
     705               ! do not used grid point to compute  
     706               ! boundaries indices (cf create_boundary) 
     707               ! as Bathymetry always on T point 
     708 
    692709            CASE('south') 
    693710 
     
    703720               il_jmin1=td_bdy%t_seg(jl)%i_first 
    704721               il_jmax1=td_bdy%t_seg(jl)%i_last  
     722 
     723               ! do not used grid point to compute  
     724               ! boundaries indices (cf create_boundary) 
     725               ! as Bathymetry always on T point 
    705726 
    706727            CASE('west') 
     
    777798            tl_var0=iom_dom_read_var(tl_bathy0,'Bathymetry',tl_dom0) 
    778799 
     800            ! force to use nearest interpolation 
     801            tl_var0%c_interp(1)='nearest' 
     802 
    779803            ! close mpp files 
    780804            CALL iom_dom_close(tl_bathy0) 
     
    814838            CASE('north') 
    815839 
     840!               ! npoint coarse 
     841!               il_width=td_bdy%t_seg(jl)%i_width-id_npoint 
     842!               ! compute "distance" 
     843!               dl_tmp1d(:)=(/(ji,ji=il_width-1,1,-1),(0,ji=1,id_npoint)/) 
     844!               ! compute weight on segment 
     845!               dl_tmp1d(:)= 0.5 + 0.5*COS( (dp_pi*dl_tmp1d(:)) / & 
     846!               &                           (il_width) ) 
     847 
    816848               ! compute "distance" 
    817                dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width,1,-1)/) 
     849               dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width-1,1,-1),0/) 
    818850 
    819851               ! compute weight on segment 
     
    831863 
    832864               ! compute "distance" 
    833                dl_tmp1d(:)=(/(ji-1,ji=1,td_bdy%t_seg(jl)%i_width)/)                
     865               dl_tmp1d(:)=(/0,(ji-1,ji=1,td_bdy%t_seg(jl)%i_width-1)/)                
    834866 
    835867               ! compute weight on segment 
     
    847879 
    848880               ! compute "distance" 
    849                dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width,1,-1)/) 
     881               dl_tmp1d(:)=(/(ji-1,ji=td_bdy%t_seg(jl)%i_width-1,1,-1),0/) 
    850882 
    851883               ! compute weight on segment 
     
    863895 
    864896               ! compute "distance" 
    865                dl_tmp1d(:)=(/(ji-1,ji=1,td_bdy%t_seg(jl)%i_width)/)                
     897               dl_tmp1d(:)=(/0,(ji-1,ji=1,td_bdy%t_seg(jl)%i_width-1)/)                
    866898 
    867899               ! compute weight on segment 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/mpp.f90

    r5616 r6392  
    196196! REVISION HISTORY: 
    197197!> @date November, 2013 - Initial Version 
    198 !> @date November, 2014 - Fix memory leaks bug 
     198!> @date November, 2014  
     199!> - Fix memory leaks bug 
     200!> @date October, 2015 
     201!> - improve way to compute domain layout 
     202!> @date January, 2016 
     203!> - allow to print layout file (use lm_layout, hard coded) 
     204!> - add mpp__compute_halo and mpp__read_halo 
    199205! 
    200206!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    214220 
    215221   ! type and variable 
    216    PUBLIC :: TMPP       !< mpp structure 
     222   PUBLIC  :: TMPP       !< mpp structure 
     223   PRIVATE :: TLAY       !< domain layout structure 
    217224 
    218225   ! function and subroutine 
     
    239246   PUBLIC :: mpp_get_proc_size  !< get processor domain size 
    240247 
    241    PRIVATE :: mpp__add_proc            ! add one proc strucutre in mpp structure 
     248   PRIVATE :: mpp__add_proc            ! add proc strucutre in mpp structure 
     249   PRIVATE :: mpp__add_proc_unit       ! add one proc strucutre in mpp structure 
    242250   PRIVATE :: mpp__del_proc            ! delete one proc strucutre in mpp structure 
    243251   PRIVATE :: mpp__del_proc_id         ! delete one proc strucutre in mpp structure, given procesor id 
    244252   PRIVATE :: mpp__del_proc_str        ! delete one proc strucutre in mpp structure, given procesor file structure  
    245253   PRIVATE :: mpp__move_proc           ! overwrite proc strucutre in mpp structure 
    246    PRIVATE :: mpp__compute             ! compute domain decomposition 
    247    PRIVATE :: mpp__del_land            ! remove land sub domain from domain decomposition 
     254   PRIVATE :: mpp__create_layout       ! create mpp structure using domain layout 
    248255   PRIVATE :: mpp__optimiz             ! compute optimum domain decomposition 
    249    PRIVATE :: mpp__land_proc           ! check if processor is a land processor 
    250256   PRIVATE :: mpp__check_dim           ! check mpp structure dimension with proc or variable dimension 
    251257   PRIVATE :: mpp__check_proc_dim      ! check if processor and mpp structure use same dimension 
     
    267273   PRIVATE :: mpp__clean_unit          ! clean mpp strcuture 
    268274   PRIVATE :: mpp__clean_arr           ! clean array of mpp strcuture 
     275   PRIVATE :: mpp__compute_halo        ! compute subdomain indices defined with halo  
     276   PRIVATE :: mpp__read_halo           ! read subdomain indices defined with halo 
     277 
     278   PRIVATE :: layout__init             ! initialise domain layout structure 
     279   PRIVATE :: layout__copy             ! clean domain layout structure 
     280   PRIVATE :: layout__clean            ! copy  domain layout structure 
    269281 
    270282   TYPE TMPP !< mpp structure 
    271  
    272283      ! general  
    273284      CHARACTER(LEN=lc)                  :: c_name = ''   !< base name  
     
    284295 
    285296      CHARACTER(LEN=lc)                  :: c_type = ''   !< type of the files (cdf, cdf4, dimg) 
    286       CHARACTER(LEN=lc)                  :: c_dom  = ''   !< type of domain (full, overlap, nooverlap) 
     297      CHARACTER(LEN=lc)                  :: c_dom  = ''   !< type of domain (full, noextra, nooverlap) 
    287298 
    288299      INTEGER(i4)                        :: i_ndim = 0    !< number of dimensions used in mpp 
     
    290301 
    291302      TYPE(TFILE), DIMENSION(:), POINTER :: t_proc => NULL()     !< files/processors composing mpp 
    292  
    293303   END TYPE 
     304 
     305   TYPE TLAY !< domain layout structure 
     306      INTEGER(i4)                          :: i_niproc = 0  !< number of processors following i 
     307      INTEGER(i4)                          :: i_njproc = 0  !< number of processors following j 
     308      INTEGER(i4)                          :: i_nland  = 0       !< number of land processors 
     309      INTEGER(i4)                          :: i_nsea   = 0       !< number of sea  processors 
     310      INTEGER(i4)                          :: i_mean   = 0       !< mean sea point per proc 
     311      INTEGER(i4)                          :: i_min    = 0       !< min  sea point per proc 
     312      INTEGER(i4)                          :: i_max    = 0       !< max  sea point per proc 
     313      INTEGER(i4), DIMENSION(:,:), POINTER :: i_msk   => NULL()  !< sea/land processor mask  
     314      INTEGER(i4), DIMENSION(:,:), POINTER :: i_impp  => NULL()  !< i-indexes for mpp-subdomain left bottom  
     315      INTEGER(i4), DIMENSION(:,:), POINTER :: i_jmpp  => NULL()  !< j-indexes for mpp-subdomain left bottom  
     316      INTEGER(i4), DIMENSION(:,:), POINTER :: i_lci   => NULL()  !< i-dimensions of subdomain  
     317      INTEGER(i4), DIMENSION(:,:), POINTER :: i_lcj   => NULL()  !< j-dimensions of subdomain  
     318   END TYPE 
     319 
     320   ! module variable 
     321   INTEGER(i4) :: im_iumout = 44 
     322   LOGICAL     :: lm_layout =.FALSE. 
    294323 
    295324   INTERFACE mpp_get_use 
    296325      MODULE PROCEDURE mpp__get_use_unit  
    297326   END INTERFACE mpp_get_use 
     327 
     328   INTERFACE mpp__add_proc 
     329      MODULE PROCEDURE mpp__add_proc_unit  
     330   END INTERFACE mpp__add_proc 
    298331 
    299332   INTERFACE mpp_clean 
     
    560593            ALLOCATE( il_lci(td_mpp%i_niproc,td_mpp%i_njproc) ) 
    561594            ALLOCATE( il_lcj(td_mpp%i_niproc,td_mpp%i_njproc) ) 
     595            il_proc(:,:)=-1 
     596            il_lci(:,:) =-1 
     597            il_lcj(:,:) =-1 
    562598 
    563599            DO jk=1,td_mpp%i_nproc 
    564600               ji=td_mpp%t_proc(jk)%i_iind 
    565601               jj=td_mpp%t_proc(jk)%i_jind 
    566                il_proc(ji,jj)=jk 
     602               il_proc(ji,jj)=jk-1 
    567603               il_lci(ji,jj)=td_mpp%t_proc(jk)%i_lci 
    568604               il_lcj(ji,jj)=td_mpp%t_proc(jk)%i_lcj 
     
    594630      ENDIF 
    595631 
    596  
    5976329400   FORMAT('     ***',20('*************',a3)) 
    5986339403   FORMAT('     *     ',20('         *   ',a3)) 
     
    615650   !> @author J.Paul 
    616651   !> @date November, 2013 - Initial version 
     652   !> @date September, 2015 
     653   !> - allow to define dimension with array of dimension structure 
     654   !> @date January, 2016 
     655   !> - use RESULT to rename output 
     656   !> - mismatch with "halo" indices 
    617657   ! 
    618658   !> @param[in] cd_file   file name of one file composing mpp domain 
     
    627667   !> @param[in] id_perio  NEMO periodicity index 
    628668   !> @param[in] id_pivot  NEMO pivot point index F(0),T(1) 
     669   !> @param[in] td_dim    array of dimension structure 
    629670   !> @return mpp structure 
    630671   !------------------------------------------------------------------- 
    631    TYPE(TMPP) FUNCTION mpp__init_mask(cd_file, id_mask,              & 
    632    &                                  id_niproc, id_njproc, id_nproc,& 
    633    &                                  id_preci, id_precj,            & 
    634                                       cd_type, id_ew, id_perio, id_pivot) 
     672   FUNCTION mpp__init_mask(cd_file, id_mask,                   & 
     673   &                       id_niproc, id_njproc, id_nproc,     & 
     674   &                       id_preci, id_precj,                 & 
     675   &                       cd_type, id_ew, id_perio, id_pivot, & 
     676   &                       td_dim )                            & 
     677   & RESULT(td_mpp) 
    635678      IMPLICIT NONE 
    636679      ! Argument 
    637       CHARACTER(LEN=*),            INTENT(IN) :: cd_file 
    638       INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask 
    639       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_niproc 
    640       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_njproc 
    641       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_nproc 
    642       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_preci 
    643       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_precj 
    644       CHARACTER(LEN=*),            INTENT(IN), OPTIONAL :: cd_type 
    645       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_ew 
    646       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_perio 
    647       INTEGER(i4),                 INTENT(IN), OPTIONAL :: id_pivot 
     680      CHARACTER(LEN=*),                  INTENT(IN) :: cd_file 
     681      INTEGER(i4), DIMENSION(:,:),       INTENT(IN) :: id_mask 
     682      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_niproc 
     683      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_njproc 
     684      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_nproc 
     685      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_preci 
     686      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_precj 
     687      CHARACTER(LEN=*),                  INTENT(IN), OPTIONAL :: cd_type 
     688      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_ew 
     689      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_perio 
     690      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_pivot 
     691      TYPE(TDIM) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: td_dim 
     692 
     693      ! function 
     694      TYPE(TMPP) :: td_mpp 
    648695 
    649696      ! local variable 
    650       CHARACTER(LEN=lc)                :: cl_type 
    651  
    652       INTEGER(i4)      , DIMENSION(2) :: il_shape 
    653  
    654       TYPE(TDIM)                      :: tl_dim 
    655  
    656       TYPE(TATT)                      :: tl_att 
     697      CHARACTER(LEN=lc)                            :: cl_type 
     698 
     699      INTEGER(i4)      , DIMENSION(2)              :: il_shape 
     700 
     701      TYPE(TDIM)                                   :: tl_dim 
     702 
     703      TYPE(TATT)                                   :: tl_att 
     704 
     705      TYPE(TLAY)                                   :: tl_lay 
     706 
    657707      ! loop indices 
    658708      INTEGER(i4) :: ji 
     
    660710 
    661711      ! clean mpp 
    662       CALL mpp_clean(mpp__init_mask) 
     712      CALL mpp_clean(td_mpp) 
    663713 
    664714      ! check type 
     
    669719         SELECT CASE(TRIM(cd_type)) 
    670720            CASE('cdf') 
    671                mpp__init_mask%c_type='cdf' 
     721               td_mpp%c_type='cdf' 
    672722            CASE('dimg') 
    673                mpp__init_mask%c_type='dimg' 
     723               td_mpp%c_type='dimg' 
    674724            CASE DEFAULT 
    675725               CALL logger_warn( "MPP INIT: type "//TRIM(cd_type)//& 
    676726               & " unknown. type dimg will be used for mpp "//& 
    677                &  TRIM(mpp__init_mask%c_name) ) 
    678                mpp__init_mask%c_type='dimg' 
     727               &  TRIM(td_mpp%c_name) ) 
     728               td_mpp%c_type='dimg' 
    679729         END SELECT 
    680730      ELSE 
    681          mpp__init_mask%c_type=TRIM(file_get_type(cd_file)) 
     731         td_mpp%c_type=TRIM(file_get_type(cd_file)) 
    682732      ENDIF 
    683733 
    684734      ! get mpp name 
    685       mpp__init_mask%c_name=TRIM(file_rename(cd_file)) 
     735      td_mpp%c_name=TRIM(file_rename(cd_file)) 
    686736 
    687737      ! get global domain dimension 
    688738      il_shape(:)=SHAPE(id_mask) 
    689739 
    690       tl_dim=dim_init('X',il_shape(1)) 
    691       CALL mpp_add_dim(mpp__init_mask, tl_dim) 
    692  
    693       tl_dim=dim_init('Y',il_shape(2)) 
    694       CALL mpp_add_dim(mpp__init_mask, tl_dim) 
    695  
    696       ! clean 
    697       CALL dim_clean(tl_dim) 
     740      IF( PRESENT(td_dim) )THEN 
     741         DO ji=1,ip_maxdim 
     742            IF( td_dim(ji)%l_use )THEN 
     743               CALL mpp_add_dim(td_mpp, td_dim(ji)) 
     744            ENDIF 
     745         ENDDO 
     746      ELSE 
     747         tl_dim=dim_init('X',il_shape(1)) 
     748         CALL mpp_add_dim(td_mpp, tl_dim) 
     749 
     750         tl_dim=dim_init('Y',il_shape(2)) 
     751         CALL mpp_add_dim(td_mpp, tl_dim) 
     752 
     753         ! clean 
     754         CALL dim_clean(tl_dim) 
     755      ENDIF 
    698756 
    699757      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_njproc))) .OR. & 
     
    703761      ELSE 
    704762         ! get number of processors following I and J 
    705          IF( PRESENT(id_niproc) ) mpp__init_mask%i_niproc=id_niproc 
    706          IF( PRESENT(id_njproc) ) mpp__init_mask%i_njproc=id_njproc 
     763         IF( PRESENT(id_niproc) ) td_mpp%i_niproc=id_niproc 
     764         IF( PRESENT(id_njproc) ) td_mpp%i_njproc=id_njproc 
    707765      ENDIF 
    708766 
    709767      ! get maximum number of processors to be used 
    710       IF( PRESENT(id_nproc) ) mpp__init_mask%i_nproc = id_nproc 
     768      IF( PRESENT(id_nproc) ) td_mpp%i_nproc = id_nproc 
    711769 
    712770      ! get overlap region length 
    713       IF( PRESENT(id_preci) ) mpp__init_mask%i_preci= id_preci 
    714       IF( PRESENT(id_precj) ) mpp__init_mask%i_precj= id_precj 
     771      IF( PRESENT(id_preci) ) td_mpp%i_preci= id_preci 
     772      IF( PRESENT(id_precj) ) td_mpp%i_precj= id_precj 
    715773 
    716774      ! east-west overlap 
    717       IF( PRESENT(id_ew) ) mpp__init_mask%i_ew= id_ew 
     775      IF( PRESENT(id_ew) ) td_mpp%i_ew= id_ew 
    718776      ! NEMO periodicity 
    719       IF( PRESENT(id_perio) ) mpp__init_mask%i_perio= id_perio 
    720       IF( PRESENT(id_pivot) ) mpp__init_mask%i_pivot= id_pivot 
    721  
    722       IF( mpp__init_mask%i_nproc  /= 0 .AND. & 
    723       &   mpp__init_mask%i_niproc /= 0 .AND. & 
    724       &   mpp__init_mask%i_njproc /= 0 .AND. & 
    725       &   mpp__init_mask%i_nproc > & 
    726       &   mpp__init_mask%i_niproc * mpp__init_mask%i_njproc )THEN 
     777      IF( PRESENT(id_perio) ) td_mpp%i_perio= id_perio 
     778      IF( PRESENT(id_pivot) ) td_mpp%i_pivot= id_pivot 
     779 
     780      IF( td_mpp%i_nproc  /= 0 .AND. & 
     781      &   td_mpp%i_niproc /= 0 .AND. & 
     782      &   td_mpp%i_njproc /= 0 .AND. & 
     783      &   td_mpp%i_nproc > & 
     784      &   td_mpp%i_niproc * td_mpp%i_njproc )THEN 
    727785 
    728786         CALL logger_error("MPP INIT: invalid domain decomposition ") 
    729787         CALL logger_debug("MPP INIT: "// & 
    730          & TRIM(fct_str(mpp__init_mask%i_nproc))//" > "//& 
    731          & TRIM(fct_str(mpp__init_mask%i_niproc))//" x "//& 
    732          & TRIM(fct_str(mpp__init_mask%i_njproc)) ) 
     788         & TRIM(fct_str(td_mpp%i_nproc))//" > "//& 
     789         & TRIM(fct_str(td_mpp%i_niproc))//" x "//& 
     790         & TRIM(fct_str(td_mpp%i_njproc)) ) 
    733791 
    734792      ELSE 
    735  
    736          IF( mpp__init_mask%i_niproc /= 0 .AND. & 
    737          &   mpp__init_mask%i_njproc /= 0 )THEN 
    738             ! compute domain decomposition 
    739             CALL mpp__compute( mpp__init_mask ) 
    740             ! remove land sub domain 
    741             CALL mpp__del_land( mpp__init_mask, id_mask ) 
    742          ELSEIF( mpp__init_mask%i_nproc  /= 0 )THEN 
     793         IF( lm_layout )THEN 
     794            OPEN(im_iumout,FILE='processor.layout') 
     795            WRITE(im_iumout,*) 
     796            WRITE(im_iumout,*) ' optimisation de la partition' 
     797            WRITE(im_iumout,*) ' ----------------------------' 
     798            WRITE(im_iumout,*) 
     799         ENDIF 
     800 
     801         IF( td_mpp%i_niproc /= 0 .AND. & 
     802         &   td_mpp%i_njproc /= 0 )THEN 
     803            ! compute domain layout 
     804            tl_lay=layout__init( td_mpp, id_mask, td_mpp%i_niproc, td_mpp%i_njproc ) 
     805            ! create mpp domain layout 
     806            CALL mpp__create_layout( td_mpp, tl_lay ) 
     807            ! clean 
     808            CALL layout__clean( tl_lay ) 
     809         ELSEIF( td_mpp%i_nproc  /= 0 )THEN 
    743810            ! optimiz 
    744             CALL mpp__optimiz( mpp__init_mask, id_mask ) 
     811            CALL mpp__optimiz( td_mpp, id_mask, td_mpp%i_nproc ) 
    745812 
    746813         ELSE 
    747814            CALL logger_warn("MPP INIT: number of processor to be used "//& 
    748815            &                "not specify. force to one.") 
    749             mpp__init_mask%i_nproc  = 1 
    750816            ! optimiz 
    751             CALL mpp__optimiz( mpp__init_mask, id_mask ) 
     817            CALL mpp__optimiz( td_mpp, id_mask, 1 ) 
    752818         ENDIF 
     819 
     820 
    753821         CALL logger_info("MPP INIT: domain decoposition : "//& 
    754          &  'niproc('//TRIM(fct_str(mpp__init_mask%i_niproc))//') * '//& 
    755          &  'njproc('//TRIM(fct_str(mpp__init_mask%i_njproc))//') = '//& 
    756          &  'nproc('//TRIM(fct_str(mpp__init_mask%i_nproc))//')' ) 
     822         &  'niproc('//TRIM(fct_str(td_mpp%i_niproc))//') * '//& 
     823         &  'njproc('//TRIM(fct_str(td_mpp%i_njproc))//') = '//& 
     824         &  'nproc('//TRIM(fct_str(td_mpp%i_nproc))//')' ) 
    757825 
    758826         ! get domain type 
    759          CALL mpp_get_dom( mpp__init_mask ) 
    760  
    761          DO ji=1,mpp__init_mask%i_nproc 
     827         CALL mpp_get_dom( td_mpp ) 
     828 
     829         DO ji=1,td_mpp%i_nproc 
    762830 
    763831            ! get processor size 
    764             il_shape(:)=mpp_get_proc_size( mpp__init_mask, ji ) 
     832            il_shape(:)=mpp_get_proc_size( td_mpp, ji ) 
    765833 
    766834            tl_dim=dim_init('X',il_shape(1)) 
    767             CALL file_move_dim(mpp__init_mask%t_proc(ji), tl_dim) 
     835            CALL file_move_dim(td_mpp%t_proc(ji), tl_dim) 
    768836 
    769837            tl_dim=dim_init('Y',il_shape(2)) 
    770             CALL file_move_dim(mpp__init_mask%t_proc(ji), tl_dim)             
    771  
     838            CALL file_move_dim(td_mpp%t_proc(ji), tl_dim)             
     839 
     840            IF( PRESENT(td_dim) )THEN 
     841               IF( td_dim(jp_K)%l_use )THEN 
     842                  CALL file_move_dim(td_mpp%t_proc(ji), td_dim(jp_K)) 
     843               ENDIF 
     844               IF( td_dim(jp_L)%l_use )THEN 
     845                  CALL file_move_dim(td_mpp%t_proc(ji), td_dim(jp_L)) 
     846               ENDIF 
     847            ENDIF 
    772848            ! add type 
    773             mpp__init_mask%t_proc(ji)%c_type=TRIM(mpp__init_mask%c_type) 
     849            td_mpp%t_proc(ji)%c_type=TRIM(td_mpp%c_type) 
    774850 
    775851            ! clean 
    776852            CALL dim_clean(tl_dim) 
     853 
    777854         ENDDO 
    778855 
    779856         ! add global attribute 
    780          tl_att=att_init("DOMAIN_number_total",mpp__init_mask%i_nproc) 
    781          CALL mpp_add_att(mpp__init_mask, tl_att) 
    782  
    783          tl_att=att_init("DOMAIN_I_number_total",mpp__init_mask%i_niproc) 
    784          CALL mpp_add_att(mpp__init_mask, tl_att) 
    785  
    786          tl_att=att_init("DOMAIN_J_number_total",mpp__init_mask%i_njproc) 
    787          CALL mpp_add_att(mpp__init_mask, tl_att) 
    788  
    789          tl_att=att_init("DOMAIN_size_global",mpp__init_mask%t_dim(1:2)%i_len) 
    790          CALL mpp_add_att(mpp__init_mask, tl_att) 
    791  
    792          tl_att=att_init( "DOMAIN_I_position_first", & 
    793          &                mpp__init_mask%t_proc(:)%i_impp ) 
    794          CALL mpp_add_att(mpp__init_mask, tl_att) 
    795  
    796          tl_att=att_init( "DOMAIN_J_position_first", & 
    797          &                mpp__init_mask%t_proc(:)%i_jmpp ) 
    798          CALL mpp_add_att(mpp__init_mask, tl_att) 
    799  
    800          tl_att=att_init( "DOMAIN_I_position_last", & 
    801          &                mpp__init_mask%t_proc(:)%i_lci ) 
    802          CALL mpp_add_att(mpp__init_mask, tl_att) 
    803  
    804          tl_att=att_init( "DOMAIN_J_position_last", & 
    805          &                mpp__init_mask%t_proc(:)%i_lcj ) 
    806          CALL mpp_add_att(mpp__init_mask, tl_att) 
    807  
    808          tl_att=att_init( "DOMAIN_I_halo_size_start", & 
    809          &                mpp__init_mask%t_proc(:)%i_ldi ) 
    810          CALL mpp_add_att(mpp__init_mask, tl_att) 
    811  
    812          tl_att=att_init( "DOMAIN_J_halo_size_start", & 
    813          &                mpp__init_mask%t_proc(:)%i_ldj ) 
    814          CALL mpp_add_att(mpp__init_mask, tl_att) 
    815  
    816          tl_att=att_init( "DOMAIN_I_halo_size_end", & 
    817          &                mpp__init_mask%t_proc(:)%i_lei ) 
    818          CALL mpp_add_att(mpp__init_mask, tl_att) 
    819  
    820          tl_att=att_init( "DOMAIN_J_halo_size_end", & 
    821          &                mpp__init_mask%t_proc(:)%i_lej ) 
    822          CALL mpp_add_att(mpp__init_mask, tl_att)          
    823  
    824          ! clean 
    825          CALL att_clean(tl_att) 
     857         tl_att=att_init("DOMAIN_number_total",td_mpp%i_nproc) 
     858         CALL mpp_add_att(td_mpp, tl_att) 
     859 
     860         tl_att=att_init("DOMAIN_LOCAL",TRIM(td_mpp%c_dom)) 
     861         CALL mpp_add_att(td_mpp, tl_att) 
     862 
     863         tl_att=att_init("DOMAIN_I_number_total",td_mpp%i_niproc) 
     864         CALL mpp_add_att(td_mpp, tl_att) 
     865 
     866         tl_att=att_init("DOMAIN_J_number_total",td_mpp%i_njproc) 
     867         CALL mpp_add_att(td_mpp, tl_att) 
     868 
     869         tl_att=att_init("DOMAIN_size_global",td_mpp%t_dim(1:2)%i_len) 
     870         CALL mpp_add_att(td_mpp, tl_att) 
     871 
     872         CALL mpp__compute_halo(td_mpp)  
    826873      ENDIF 
    827874 
     
    880927         il_mask(:,:,:)=var_get_mask(td_var) 
    881928          
     929         CALL logger_info("MPP INIT: mask compute from variable "//& 
     930            &             TRIM(td_var%c_name)) 
    882931         mpp__init_var=mpp_init( cd_file, il_mask(:,:,1),       & 
    883932         &                       id_niproc, id_njproc, id_nproc,& 
     
    907956   !>    - DOMAIN_halo_size_end 
    908957   !>  or the file is assume to be no mpp file. 
    909    !>   
    910    !>  
    911958   !> 
    912959   !> @author J.Paul 
    913960   !> @date November, 2013 - Initial Version 
     961   !> @date January, 2016 
     962   !> - mismatch with "halo" indices, use mpp__compute_halo 
    914963   ! 
    915964   !> @param[in] td_file   file strcuture 
     
    929978 
    930979      ! local variable 
    931       TYPE(TMPP)  :: tl_mpp 
    932        
    933       TYPE(TFILE) :: tl_file 
    934        
    935       TYPE(TDIM)  :: tl_dim 
    936  
    937       TYPE(TATT)  :: tl_att 
    938  
    939       INTEGER(i4) :: il_nproc 
    940       INTEGER(i4) :: il_attid 
    941  
     980      INTEGER(i4)               :: il_nproc 
     981      INTEGER(i4)               :: il_attid 
    942982      INTEGER(i4), DIMENSION(2) :: il_shape 
     983 
     984      TYPE(TDIM)                :: tl_dim 
     985 
     986      TYPE(TATT)                :: tl_att 
     987 
     988      TYPE(TFILE)               :: tl_file 
     989 
     990      TYPE(TMPP)                :: tl_mpp 
     991 
    943992      ! loop indices 
    944993      INTEGER(i4) :: ji 
     
    9561005            ! open file 
    9571006            CALL iom_open(tl_file) 
    958  
    9591007            ! read first file domain decomposition 
    9601008            tl_mpp=mpp__init_file_cdf(tl_file) 
     
    10291077            CALL mpp_move_att(mpp__init_file, tl_att) 
    10301078 
    1031             tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp ) 
    1032             CALL mpp_move_att(mpp__init_file, tl_att) 
    1033  
    1034             tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp ) 
    1035             CALL mpp_move_att(mpp__init_file, tl_att) 
    1036  
    1037             tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci ) 
    1038             CALL mpp_move_att(mpp__init_file, tl_att) 
    1039  
    1040             tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj ) 
    1041             CALL mpp_move_att(mpp__init_file, tl_att) 
    1042  
    1043             tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi ) 
    1044             CALL mpp_move_att(mpp__init_file, tl_att) 
    1045  
    1046             tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj ) 
    1047             CALL mpp_move_att(mpp__init_file, tl_att) 
    1048  
    1049             tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei ) 
    1050             CALL mpp_move_att(mpp__init_file, tl_att) 
    1051  
    1052             tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej ) 
    1053             CALL mpp_move_att(mpp__init_file, tl_att) 
    1054              
     1079            CALL mpp__compute_halo(mpp__init_file) 
     1080  
    10551081            ! clean 
    10561082            CALL mpp_clean(tl_mpp) 
     
    11301156   !> @author J.Paul 
    11311157   !> @date November, 2013 - Initial Version 
    1132    !> @date July, 2015 - add only use dimension in MPP structure 
     1158   !> @date July, 2015  
     1159   !> - add only use dimension in MPP structure 
     1160   !> @date January, 2016 
     1161   !> - mismatch with "halo" indices, use mpp__read_halo 
    11331162   !> 
    11341163   !> @param[in] td_file   file strcuture 
     
    12181247            tl_proc%t_dim(:)=dim_copy(td_file%t_dim(:)) 
    12191248 
    1220             ! DOMAIN_position_first 
    1221             il_attid = 0 
    1222             IF( ASSOCIATED(td_file%t_att) )THEN 
    1223                il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" ) 
    1224             ENDIF 
    1225             IF( il_attid /= 0 )THEN 
    1226                tl_proc%i_impp = INT(td_file%t_att(il_attid)%d_value(1)) 
    1227                tl_proc%i_jmpp = INT(td_file%t_att(il_attid)%d_value(2)) 
    1228             ELSE 
    1229                tl_proc%i_impp = 1 
    1230                tl_proc%i_jmpp = 1 
    1231             ENDIF 
    1232  
    1233             ! DOMAIN_position_last 
    1234             il_attid = 0 
    1235             IF( ASSOCIATED(td_file%t_att) )THEN 
    1236                il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" ) 
    1237             ENDIF 
    1238             IF( il_attid /= 0 )THEN 
    1239                tl_proc%i_lci = INT(td_file%t_att(il_attid)%d_value(1)) + tl_proc%i_impp 
    1240                tl_proc%i_lcj = INT(td_file%t_att(il_attid)%d_value(2)) + tl_proc%i_jmpp 
    1241             ELSE 
    1242                tl_proc%i_lci = mpp__init_file_cdf%t_dim(1)%i_len 
    1243                tl_proc%i_lcj = mpp__init_file_cdf%t_dim(2)%i_len 
    1244             ENDIF 
    1245  
    1246             ! DOMAIN_halo_size_start 
    1247             il_attid = 0 
    1248             IF( ASSOCIATED(td_file%t_att) )THEN 
    1249                il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" ) 
    1250             ENDIF 
    1251             IF( il_attid /= 0 )THEN 
    1252                tl_proc%i_ldi = INT(td_file%t_att(il_attid)%d_value(1)) 
    1253                tl_proc%i_ldj = INT(td_file%t_att(il_attid)%d_value(2)) 
    1254             ELSE 
    1255                tl_proc%i_ldi = 1 
    1256                tl_proc%i_ldj = 1 
    1257             ENDIF 
    1258  
    1259             ! DOMAIN_halo_size_end 
    1260             il_attid = 0 
    1261             IF( ASSOCIATED(td_file%t_att) )THEN 
    1262                il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" ) 
    1263             ENDIF 
    1264             IF( il_attid /= 0 )THEN 
    1265                tl_proc%i_lei = INT(td_file%t_att(il_attid)%d_value(1)) 
    1266                tl_proc%i_lej = INT(td_file%t_att(il_attid)%d_value(2)) 
    1267             ELSE 
    1268                tl_proc%i_lei = mpp__init_file_cdf%t_dim(1)%i_len 
    1269                tl_proc%i_lej = mpp__init_file_cdf%t_dim(2)%i_len 
    1270             ENDIF 
     1249            CALL mpp__read_halo(tl_proc, mpp__init_file_cdf%t_dim(:) ) 
    12711250 
    12721251            ! add attributes 
     
    12781257            CALL file_move_att(tl_proc, tl_att) 
    12791258 
    1280             tl_att=att_init( "DOMAIN_position_first", & 
    1281             &                (/tl_proc%i_impp, tl_proc%i_jmpp /) ) 
    1282             CALL file_move_att(tl_proc, tl_att) 
    1283  
    1284             tl_att=att_init( "DOMAIN_position_last", & 
    1285             &                (/tl_proc%i_lci, tl_proc%i_lcj /) ) 
    1286             CALL file_move_att(tl_proc, tl_att) 
    1287  
    1288             tl_att=att_init( "DOMAIN_halo_size_start", & 
    1289             &                (/tl_proc%i_ldi, tl_proc%i_ldj /) ) 
    1290             CALL file_move_att(tl_proc, tl_att) 
    1291  
    1292             tl_att=att_init( "DOMAIN_halo_size_end", & 
    1293             &                (/tl_proc%i_lei, tl_proc%i_lej /) ) 
    1294             CALL file_move_att(tl_proc, tl_att) 
    1295  
    12961259            ! add processor to mpp structure 
    12971260            CALL mpp__add_proc(mpp__init_file_cdf, tl_proc) 
     
    12991262            ! clean  
    13001263            CALL file_clean(tl_proc) 
     1264            CALL dim_clean(tl_dim) 
    13011265            CALL att_clean(tl_att) 
    13021266         ENDIF 
     
    13071271         &  " do not exist") 
    13081272 
    1309       ENDIF       
     1273      ENDIF 
     1274 
    13101275   END FUNCTION mpp__init_file_cdf 
    13111276   !------------------------------------------------------------------- 
     
    13171282   !> @author J.Paul 
    13181283   !> @date November, 2013 - Initial Version 
    1319    ! 
     1284   !> @date January, 2016 
     1285   !> - mismatch with "halo" indices, use mpp__compute_halo 
     1286   !> 
    13201287   !> @param[in] td_file   file strcuture 
    13211288   !> @return mpp structure 
     
    13361303      INTEGER(i4)       :: il_pni, il_pnj, il_pnij          ! domain decomposition 
    13371304      INTEGER(i4)       :: il_area                          ! domain index 
     1305 
     1306      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci 
     1307      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi 
     1308      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei 
     1309      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp 
     1310      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj 
     1311      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj 
     1312      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej 
     1313      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp 
    13381314 
    13391315      LOGICAL           ::  ll_exist 
     
    13891365            ALLOCATE( mpp__init_file_rstdimg%t_proc(il_pnij) , stat=il_status ) 
    13901366 
     1367            ALLOCATE(il_lci (il_pnij)) 
     1368            ALLOCATE(il_lcj (il_pnij)) 
     1369            ALLOCATE(il_ldi (il_pnij)) 
     1370            ALLOCATE(il_ldj (il_pnij)) 
     1371            ALLOCATE(il_lei (il_pnij)) 
     1372            ALLOCATE(il_lej (il_pnij)) 
     1373            ALLOCATE(il_impp(il_pnij)) 
     1374            ALLOCATE(il_jmpp(il_pnij)) 
     1375 
    13911376            tl_proc=file_copy(td_file) 
    13921377            ! remove dimension from file 
     
    14111396            &     il_area,                         & 
    14121397            &     il_iglo, il_jglo,                & 
    1413             &     mpp__init_file_rstdimg%t_proc(:)%i_lci,    & 
    1414             &     mpp__init_file_rstdimg%t_proc(:)%i_lcj,    & 
    1415             &     mpp__init_file_rstdimg%t_proc(:)%i_ldi,    & 
    1416             &     mpp__init_file_rstdimg%t_proc(:)%i_ldj,    & 
    1417             &     mpp__init_file_rstdimg%t_proc(:)%i_lei,    & 
    1418             &     mpp__init_file_rstdimg%t_proc(:)%i_lej,    & 
    1419             &     mpp__init_file_rstdimg%t_proc(:)%i_impp,   & 
    1420             &     mpp__init_file_rstdimg%t_proc(:)%i_jmpp 
     1398            &     il_lci(1:il_pnij),    & 
     1399            &     il_lcj(1:il_pnij),    & 
     1400            &     il_ldi(1:il_pnij),    & 
     1401            &     il_ldj(1:il_pnij),    & 
     1402            &     il_lei(1:il_pnij),    & 
     1403            &     il_lej(1:il_pnij),    & 
     1404            &     il_impp(1:il_pnij),   & 
     1405            &     il_jmpp(1:il_pnij) 
    14211406            CALL fct_err(il_status) 
    14221407            IF( il_status /= 0 )THEN 
     
    14241409               &              TRIM(td_file%c_name)) 
    14251410            ENDIF 
     1411 
     1412            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lci = il_lci (1:il_pnij) 
     1413            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lcj = il_lcj (1:il_pnij)  
     1414            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_ldi = il_ldi (1:il_pnij)  
     1415            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_ldj = il_ldj (1:il_pnij)  
     1416            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lei = il_lei (1:il_pnij)  
     1417            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_lej = il_lej (1:il_pnij)  
     1418            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_impp= il_impp(1:il_pnij) 
     1419            mpp__init_file_rstdimg%t_proc(1:il_pnij)%i_jmpp= il_jmpp(1:il_pnij) 
     1420 
     1421            DEALLOCATE(il_lci)  
     1422            DEALLOCATE(il_lcj)  
     1423            DEALLOCATE(il_ldi)  
     1424            DEALLOCATE(il_ldj)  
     1425            DEALLOCATE(il_lei)  
     1426            DEALLOCATE(il_lej)  
     1427            DEALLOCATE(il_impp) 
     1428            DEALLOCATE(il_jmpp) 
    14261429 
    14271430            ! global domain size 
     
    14351438 
    14361439            DO ji=1,mpp__init_file_rstdimg%i_nproc 
     1440 
    14371441               ! get file name 
    14381442               cl_file =  file_rename(td_file%c_name,ji) 
     
    14451449               CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)  
    14461450 
    1447                tl_att=att_init( "DOMAIN_position_first", & 
    1448                &                (/mpp__init_file_rstdimg%t_proc(ji)%i_impp, & 
    1449                &                  mpp__init_file_rstdimg%t_proc(ji)%i_jmpp /) ) 
    1450                CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att) 
    1451  
    1452                tl_att=att_init( "DOMAIN_position_last", & 
    1453                &                (/mpp__init_file_rstdimg%t_proc(ji)%i_lci, & 
    1454                &                  mpp__init_file_rstdimg%t_proc(ji)%i_lcj /) ) 
    1455                CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att) 
    1456  
    1457                tl_att=att_init( "DOMAIN_halo_size_start", & 
    1458                &                (/mpp__init_file_rstdimg%t_proc(ji)%i_ldi, & 
    1459                &                  mpp__init_file_rstdimg%t_proc(ji)%i_ldj /) ) 
    1460                CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att)                
    1461  
    1462                tl_att=att_init( "DOMAIN_halo_size_end", & 
    1463                &                (/mpp__init_file_rstdimg%t_proc(ji)%i_lei, & 
    1464                &                  mpp__init_file_rstdimg%t_proc(ji)%i_lej /) ) 
    1465                CALL file_move_att(mpp__init_file_rstdimg%t_proc(ji), tl_att) 
    14661451            ENDDO 
    14671452  
     
    14861471            CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    14871472 
    1488             tl_att=att_init( "DOMAIN_I_position_first", & 
    1489             &                 mpp__init_file_rstdimg%t_proc(:)%i_impp ) 
    1490             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1491  
    1492             tl_att=att_init( "DOMAIN_J_position_first", & 
    1493             &                 mpp__init_file_rstdimg%t_proc(:)%i_jmpp ) 
    1494             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1495  
    1496             tl_att=att_init( "DOMAIN_I_position_last", & 
    1497             &                 mpp__init_file_rstdimg%t_proc(:)%i_lci ) 
    1498             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1499  
    1500             tl_att=att_init( "DOMAIN_J_position_last", & 
    1501             &                 mpp__init_file_rstdimg%t_proc(:)%i_lcj ) 
    1502             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1503  
    1504             tl_att=att_init( "DOMAIN_I_halo_size_start", & 
    1505             &                 mpp__init_file_rstdimg%t_proc(:)%i_ldi ) 
    1506             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1507  
    1508             tl_att=att_init( "DOMAIN_J_halo_size_start", & 
    1509             &                 mpp__init_file_rstdimg%t_proc(:)%i_ldj ) 
    1510             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1511  
    1512             tl_att=att_init( "DOMAIN_I_halo_size_end", & 
    1513             &                 mpp__init_file_rstdimg%t_proc(:)%i_lei ) 
    1514             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
    1515  
    1516             tl_att=att_init( "DOMAIN_J_halo_size_end", & 
    1517             &                 mpp__init_file_rstdimg%t_proc(:)%i_lej ) 
    1518             CALL mpp_move_att(mpp__init_file_rstdimg, tl_att) 
     1473            CALL mpp_get_dom( mpp__init_file_rstdimg ) 
     1474 
     1475            CALL mpp__compute_halo( mpp__init_file_rstdimg ) 
    15191476 
    15201477            ! clean 
     
    15981555      ! Argument 
    15991556      TYPE(TMPP), INTENT(INOUT) :: td_mpp 
    1600       TYPE(TVAR), INTENT(IN)    :: td_var 
     1557      TYPE(TVAR), INTENT(INOUT) :: td_var 
    16011558 
    16021559      ! local variable 
     
    16461603               ! check used dimension  
    16471604               IF( mpp__check_dim(td_mpp, td_var) )THEN 
     1605          
     1606                  ! check variable dimension expected 
     1607                  CALL var_check_dim(td_var) 
    16481608 
    16491609                  ! update dimension if need be 
     
    19151875      TYPE(TVAR) :: tl_var 
    19161876      !---------------------------------------------------------------- 
    1917       ! copy variable 
     1877      ! copy variablie 
    19181878      tl_var=var_copy(td_var) 
    19191879 
     
    19421902   !> - check proc type 
    19431903   !------------------------------------------------------------------- 
    1944    SUBROUTINE mpp__add_proc( td_mpp, td_proc ) 
     1904   SUBROUTINE mpp__add_proc_unit( td_mpp, td_proc ) 
    19451905      IMPLICIT NONE 
    19461906      ! Argument 
     
    19571917      CHARACTER(LEN=lc)                            :: cl_name 
    19581918      !---------------------------------------------------------------- 
     1919 
     1920!      ALLOCATE(tl_proc(1)) 
     1921!      tl_proc(1)=file_copy(td_proc) 
     1922! 
     1923!      CALL mpp__add_proc(td_mpp, tl_proc(:)) 
     1924! 
     1925!      CALL file_clean(tl_proc(:)) 
     1926!      DEALLOCATE(tl_proc) 
    19591927 
    19601928      ! check file name 
     
    20562024 
    20572025      ENDIF 
    2058    END SUBROUTINE mpp__add_proc 
     2026 
     2027   END SUBROUTINE mpp__add_proc_unit 
    20592028   !------------------------------------------------------------------- 
    20602029   !> @brief 
     
    25752544   !------------------------------------------------------------------- 
    25762545   !> @brief 
    2577    !>    This subroutine compute domain decomposition for niproc and njproc  
    2578    !> processors following I and J. 
    2579    !> 
     2546   !>    This function initialise domain layout 
     2547   !>  
    25802548   !> @detail 
    2581    !> To do so, it need to know : 
    2582    !> - global domain dimension 
    2583    !> - overlap region length 
    2584    !> - number of processors following I and J 
     2549   !> Domain layout is first compute, with domain dimension, overlap between subdomain, 
     2550   !> and the number of processors following I and J. 
     2551   !> Then the number of sea/land processors is compute with mask 
    25852552   ! 
    25862553   !> @author J.Paul 
    2587    !> @date November, 2013 - Initial version 
     2554   !> @date October, 2015 - Initial version 
     2555   ! 
     2556   !> @param[in] td_mpp mpp strcuture 
     2557   !> @param[in] id_mask   sub domain mask (sea=1, land=0) 
     2558   !> @pâram[in] id_niproc number of processors following I 
     2559   !> @pâram[in] id_njproc number of processors following J 
     2560   !> @return domain layout structure 
     2561   !------------------------------------------------------------------- 
     2562   FUNCTION layout__init( td_mpp, id_mask, id_niproc, id_njproc ) RESULT(td_lay) 
     2563      IMPLICIT NONE 
     2564      ! Argument 
     2565      TYPE(TMPP)                 , INTENT(IN) :: td_mpp 
     2566      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask 
     2567      INTEGER(i4)                , INTENT(IN) :: id_niproc 
     2568      INTEGER(i4)                , INTENT(IN) :: id_njproc 
     2569 
     2570      ! function 
     2571      TYPE(TLAY) :: td_lay 
     2572 
     2573      ! local variable 
     2574      INTEGER(i4) :: ii1, ii2 
     2575      INTEGER(i4) :: ij1, ij2 
     2576 
     2577      INTEGER(i4) :: il_ldi 
     2578      INTEGER(i4) :: il_ldj 
     2579      INTEGER(i4) :: il_lei 
     2580      INTEGER(i4) :: il_lej 
     2581 
     2582      INTEGER(i4) :: il_isize !< i-direction maximum sub domain size  
     2583      INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size 
     2584      INTEGER(i4) :: il_resti !<   
     2585      INTEGER(i4) :: il_restj !<   
     2586 
     2587      ! loop indices 
     2588      INTEGER(i4) :: ji 
     2589      INTEGER(i4) :: jj 
     2590      !---------------------------------------------------------------- 
     2591 
     2592      ! intialise 
     2593      td_lay%i_niproc=id_niproc 
     2594      td_lay%i_njproc=id_njproc 
     2595 
     2596      CALL logger_info( "MPP COMPUTE LAYOUT: compute domain layout with "//& 
     2597      &               TRIM(fct_str(td_lay%i_niproc))//" x "//& 
     2598      &               TRIM(fct_str(td_lay%i_njproc))//" processors") 
     2599 
     2600      ! maximum size of sub domain 
     2601      il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (td_lay%i_niproc-1))/ & 
     2602      &           td_lay%i_niproc) + 2*td_mpp%i_preci 
     2603      il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (td_lay%i_njproc-1))/ & 
     2604      &           td_lay%i_njproc) + 2*td_mpp%i_precj 
     2605 
     2606      il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, td_lay%i_niproc) 
     2607      il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, td_lay%i_njproc) 
     2608      IF( il_resti == 0 ) il_resti = td_lay%i_niproc 
     2609      IF( il_restj == 0 ) il_restj = td_lay%i_njproc 
     2610 
     2611      ! compute dimension of each sub domain 
     2612      ALLOCATE( td_lay%i_lci(td_lay%i_niproc,td_lay%i_njproc) ) 
     2613      ALLOCATE( td_lay%i_lcj(td_lay%i_niproc,td_lay%i_njproc) ) 
     2614 
     2615      td_lay%i_lci( 1          : il_resti       , : ) = il_isize 
     2616      td_lay%i_lci( il_resti+1 : td_lay%i_niproc, : ) = il_isize-1 
     2617 
     2618      td_lay%i_lcj( : , 1          : il_restj       ) = il_jsize 
     2619      td_lay%i_lcj( : , il_restj+1 : td_lay%i_njproc) = il_jsize-1 
     2620 
     2621      ! compute first index of each sub domain 
     2622      ALLOCATE( td_lay%i_impp(td_lay%i_niproc,td_lay%i_njproc) ) 
     2623      ALLOCATE( td_lay%i_jmpp(td_lay%i_niproc,td_lay%i_njproc) ) 
     2624 
     2625      td_lay%i_impp(:,:)=1 
     2626      td_lay%i_jmpp(:,:)=1 
     2627 
     2628      IF( td_lay%i_niproc > 1 )THEN 
     2629         DO jj=1,td_lay%i_njproc 
     2630            DO ji=2,td_lay%i_niproc 
     2631               td_lay%i_impp(ji,jj) = td_lay%i_impp(ji-1,jj) + & 
     2632               &                       td_lay%i_lci (ji-1,jj) - 2*td_mpp%i_preci 
     2633            ENDDO 
     2634         ENDDO 
     2635      ENDIF 
     2636 
     2637      IF( td_lay%i_njproc > 1 )THEN 
     2638         DO jj=2,td_lay%i_njproc 
     2639            DO ji=1,td_lay%i_niproc 
     2640               td_lay%i_jmpp(ji,jj) = td_lay%i_jmpp(ji,jj-1) + & 
     2641               &                       td_lay%i_lcj (ji,jj-1) - 2*td_mpp%i_precj 
     2642            ENDDO 
     2643         ENDDO  
     2644      ENDIF 
     2645 
     2646      ALLOCATE(td_lay%i_msk(td_lay%i_niproc,td_lay%i_njproc)) 
     2647      td_lay%i_msk(:,:)=0 
     2648      ! init number of sea/land proc 
     2649      td_lay%i_nsea=0 
     2650      td_lay%i_nland=td_lay%i_njproc*td_lay%i_niproc 
     2651 
     2652      ! check if processor is land or sea 
     2653      DO jj = 1,td_lay%i_njproc 
     2654         DO ji = 1,td_lay%i_niproc 
     2655 
     2656            ! compute first and last indoor indices 
     2657            ! west boundary 
     2658            IF( ji == 1 )THEN 
     2659               il_ldi = 1  
     2660            ELSE 
     2661               il_ldi = 1 + td_mpp%i_preci 
     2662            ENDIF 
     2663 
     2664            ! south boundary 
     2665            IF( jj == 1 )THEN 
     2666               il_ldj = 1  
     2667            ELSE 
     2668               il_ldj = 1 + td_mpp%i_precj 
     2669            ENDIF 
     2670 
     2671            ! east boundary 
     2672            IF( ji == td_mpp%i_niproc )THEN 
     2673               il_lei = td_lay%i_lci(ji,jj) 
     2674            ELSE 
     2675               il_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci 
     2676            ENDIF 
     2677 
     2678            ! north boundary 
     2679            IF( jj == td_mpp%i_njproc )THEN 
     2680               il_lej = td_lay%i_lcj(ji,jj) 
     2681            ELSE 
     2682               il_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj 
     2683            ENDIF 
     2684 
     2685            ii1=td_lay%i_impp(ji,jj) + il_ldi - 1 
     2686            ii2=td_lay%i_impp(ji,jj) + il_lei - 1 
     2687 
     2688            ij1=td_lay%i_jmpp(ji,jj) + il_ldj - 1 
     2689            ij2=td_lay%i_jmpp(ji,jj) + il_lej - 1 
     2690 
     2691            td_lay%i_msk(ji,jj)=SUM( id_mask(ii1:ii2,ij1:ij2) ) 
     2692            IF( td_lay%i_msk(ji,jj) > 0 )THEN ! sea 
     2693               td_lay%i_nsea =td_lay%i_nsea +1 
     2694               td_lay%i_nland=td_lay%i_nland-1 
     2695            ENDIF 
     2696 
     2697         ENDDO 
     2698      ENDDO 
     2699 
     2700      CALL logger_info( "MPP COMPUTE LAYOUT: sea proc "//TRIM(fct_str(td_lay%i_nsea))) 
     2701      CALL logger_info( "MPP COMPUTE LAYOUT: land proc "//TRIM(fct_str(td_lay%i_nland))) 
     2702      CALL logger_info( "MPP COMPUTE LAYOUT: sum "//TRIM(fct_str( SUM(td_lay%i_msk(:,:))))) 
     2703 
     2704      td_lay%i_mean= SUM(td_lay%i_msk(:,:)) / td_lay%i_nsea 
     2705      td_lay%i_min = MINVAL(td_lay%i_msk(:,:),td_lay%i_msk(:,:)/=0) 
     2706      td_lay%i_max = MAXVAL(td_lay%i_msk(:,:)) 
     2707 
     2708      IF( lm_layout )THEN 
     2709         ! print info  
     2710         WRITE(im_iumout,*) ' ' 
     2711         WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc 
     2712         WRITE(im_iumout,*) " jpi= ",il_isize," jpj= ",il_jsize 
     2713         WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj 
     2714 
     2715 
     2716         WRITE(im_iumout,*) ' nombre de processeurs       ',td_lay%i_niproc*td_lay%i_njproc 
     2717         WRITE(im_iumout,*) ' nombre de processeurs mer   ',td_lay%i_nsea 
     2718         WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland 
     2719         WRITE(im_iumout,*) ' moyenne de recouvrement     ',td_lay%i_mean 
     2720         WRITE(im_iumout,*) ' minimum de recouvrement     ',td_lay%i_min 
     2721         WRITE(im_iumout,*) ' maximum de recouvrement     ',td_lay%i_max 
     2722      ENDIF 
     2723 
     2724   END FUNCTION layout__init 
     2725   !------------------------------------------------------------------- 
     2726   !> @brief  
     2727   !>  This subroutine clean domain layout strcuture. 
     2728   !> 
     2729   !> @author J.Paul 
     2730   !> @date October, 2015 - Initial version 
     2731   !> 
     2732   !> @param[inout] td_lay domain layout strcuture 
     2733   !------------------------------------------------------------------- 
     2734   SUBROUTINE layout__clean( td_lay ) 
     2735      IMPLICIT NONE 
     2736      ! Argument 
     2737      TYPE(TLAY),  INTENT(INOUT) :: td_lay 
     2738      !---------------------------------------------------------------- 
     2739 
     2740      IF( ASSOCIATED(td_lay%i_msk) )THEN 
     2741         DEALLOCATE(td_lay%i_msk) 
     2742      ENDIF 
     2743      IF( ASSOCIATED(td_lay%i_impp) )THEN 
     2744         DEALLOCATE(td_lay%i_impp) 
     2745      ENDIF 
     2746      IF( ASSOCIATED(td_lay%i_jmpp) )THEN 
     2747         DEALLOCATE(td_lay%i_jmpp) 
     2748      ENDIF 
     2749      IF( ASSOCIATED(td_lay%i_lci) )THEN 
     2750         DEALLOCATE(td_lay%i_lci) 
     2751      ENDIF 
     2752      IF( ASSOCIATED(td_lay%i_lcj) )THEN 
     2753         DEALLOCATE(td_lay%i_lcj) 
     2754      ENDIF 
     2755 
     2756      td_lay%i_niproc=0 
     2757      td_lay%i_njproc=0 
     2758      td_lay%i_nland =0 
     2759      td_lay%i_nsea  =0 
     2760 
     2761      td_lay%i_mean  =0 
     2762      td_lay%i_min   =0 
     2763      td_lay%i_max   =0 
     2764 
     2765   END SUBROUTINE layout__clean 
     2766   !------------------------------------------------------------------- 
     2767   !> @brief 
     2768   !> This subroutine copy domain layout structure in another one. 
     2769   !> 
     2770   !> @warning do not use on the output of a function who create or read a 
     2771   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden). 
     2772   !> This will create memory leaks. 
     2773   !> @warning to avoid infinite loop, do not use any function inside  
     2774   !> this subroutine 
     2775   !> 
     2776   !> @author J.Paul 
     2777   !> @date October, 2015 - Initial Version 
     2778   ! 
     2779   !> @param[in] td_lay   domain layout structure 
     2780   !> @return copy of input domain layout structure 
     2781   !------------------------------------------------------------------- 
     2782   FUNCTION layout__copy( td_lay ) 
     2783      IMPLICIT NONE 
     2784      ! Argument 
     2785      TYPE(TLAY), INTENT(IN)  :: td_lay 
     2786      ! function 
     2787      TYPE(TLAY) :: layout__copy 
     2788 
     2789      ! local variable 
     2790      INTEGER(i4), DIMENSION(2)                :: il_shape 
     2791      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp 
     2792      ! loop indices 
     2793      !---------------------------------------------------------------- 
     2794 
     2795      ! copy scalar  
     2796      layout__copy%i_niproc   = td_lay%i_niproc 
     2797      layout__copy%i_njproc   = td_lay%i_njproc 
     2798      layout__copy%i_nland    = td_lay%i_nland  
     2799      layout__copy%i_nsea     = td_lay%i_nsea   
     2800      layout__copy%i_mean     = td_lay%i_mean   
     2801      layout__copy%i_min      = td_lay%i_min    
     2802      layout__copy%i_max      = td_lay%i_max    
     2803 
     2804      ! copy pointers 
     2805      IF( ASSOCIATED(layout__copy%i_msk) )THEN 
     2806         DEALLOCATE(layout__copy%i_msk) 
     2807      ENDIF 
     2808      IF( ASSOCIATED(td_lay%i_msk) )THEN 
     2809         il_shape(:)=SHAPE(td_lay%i_msk(:,:)) 
     2810         ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) ) 
     2811         layout__copy%i_msk(:,:)=td_lay%i_msk(:,:) 
     2812      ENDIF 
     2813 
     2814      IF( ASSOCIATED(layout__copy%i_msk) ) DEALLOCATE(layout__copy%i_msk) 
     2815      IF( ASSOCIATED(td_lay%i_msk) )THEN 
     2816         il_shape(:)=SHAPE(td_lay%i_msk(:,:)) 
     2817         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 
     2818         il_tmp(:,:)=td_lay%i_msk(:,:) 
     2819 
     2820         ALLOCATE( layout__copy%i_msk(il_shape(jp_I),il_shape(jp_J)) ) 
     2821         layout__copy%i_msk(:,:)=il_tmp(:,:) 
     2822 
     2823         DEALLOCATE(il_tmp) 
     2824      ENDIF 
     2825 
     2826      IF( ASSOCIATED(layout__copy%i_impp) ) DEALLOCATE(layout__copy%i_impp) 
     2827      IF( ASSOCIATED(td_lay%i_impp) )THEN 
     2828         il_shape(:)=SHAPE(td_lay%i_impp(:,:)) 
     2829         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 
     2830         il_tmp(:,:)=td_lay%i_impp(:,:) 
     2831 
     2832         ALLOCATE( layout__copy%i_impp(il_shape(jp_I),il_shape(jp_J)) ) 
     2833         layout__copy%i_impp(:,:)=il_tmp(:,:) 
     2834 
     2835         DEALLOCATE(il_tmp) 
     2836      ENDIF 
     2837 
     2838      IF( ASSOCIATED(layout__copy%i_jmpp) ) DEALLOCATE(layout__copy%i_jmpp) 
     2839      IF( ASSOCIATED(td_lay%i_jmpp) )THEN 
     2840         il_shape(:)=SHAPE(td_lay%i_jmpp(:,:)) 
     2841         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 
     2842         il_tmp(:,:)=td_lay%i_jmpp(:,:) 
     2843 
     2844         ALLOCATE( layout__copy%i_jmpp(il_shape(jp_I),il_shape(jp_J)) ) 
     2845         layout__copy%i_jmpp(:,:)=il_tmp(:,:) 
     2846 
     2847         DEALLOCATE(il_tmp) 
     2848      ENDIF 
     2849 
     2850      IF( ASSOCIATED(layout__copy%i_lci) ) DEALLOCATE(layout__copy%i_lci) 
     2851      IF( ASSOCIATED(td_lay%i_lci) )THEN 
     2852         il_shape(:)=SHAPE(td_lay%i_lci(:,:)) 
     2853         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 
     2854         il_tmp(:,:)=td_lay%i_lci(:,:) 
     2855 
     2856         ALLOCATE( layout__copy%i_lci(il_shape(jp_I),il_shape(jp_J)) ) 
     2857         layout__copy%i_lci(:,:)=il_tmp(:,:) 
     2858 
     2859         DEALLOCATE(il_tmp) 
     2860      ENDIF 
     2861 
     2862      IF( ASSOCIATED(layout__copy%i_lcj) ) DEALLOCATE(layout__copy%i_lcj) 
     2863      IF( ASSOCIATED(td_lay%i_lcj) )THEN 
     2864         il_shape(:)=SHAPE(td_lay%i_lcj(:,:)) 
     2865         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J))) 
     2866         il_tmp(:,:)=td_lay%i_lcj(:,:) 
     2867 
     2868         ALLOCATE( layout__copy%i_lcj(il_shape(jp_I),il_shape(jp_J)) ) 
     2869         layout__copy%i_lcj(:,:)=il_tmp(:,:) 
     2870 
     2871         DEALLOCATE(il_tmp) 
     2872      ENDIF 
     2873 
     2874   END FUNCTION layout__copy 
     2875   !------------------------------------------------------------------- 
     2876   !> @brief 
     2877   !>    This subroutine create mpp structure using domain layout 
     2878   !> 
     2879   !> @detail 
     2880   ! 
     2881   !> @author J.Paul 
     2882   !> @date October, 2015 - Initial version 
    25882883   ! 
    25892884   !> @param[inout] td_mpp mpp strcuture 
    2590    !------------------------------------------------------------------- 
    2591    SUBROUTINE mpp__compute( td_mpp ) 
     2885   !> @param[in] td_lay domain layout structure 
     2886   !------------------------------------------------------------------- 
     2887   SUBROUTINE mpp__create_layout( td_mpp, td_lay ) 
    25922888      IMPLICIT NONE 
    25932889      ! Argument 
    25942890      TYPE(TMPP), INTENT(INOUT) :: td_mpp 
     2891      TYPE(TLAY), INTENT(IN   ) :: td_lay 
    25952892 
    25962893      ! local variable 
    2597       INTEGER(i4)                              :: il_isize !< i-direction maximum sub domain size  
    2598       INTEGER(i4)                              :: il_jsize !< j-direction maximum sub domain size 
    2599       INTEGER(i4)                              :: il_resti !<   
    2600       INTEGER(i4)                              :: il_restj !<   
    2601       INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_nlci 
    2602       INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_nlcj 
    2603       INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_impp 
    2604       INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_jmpp 
    2605  
    26062894      CHARACTER(LEN=lc)                        :: cl_file 
    26072895      TYPE(TFILE)                              :: tl_proc 
     
    26172905      td_mpp%i_nproc=0 
    26182906 
    2619       CALL logger_trace( "MPP COMPUTE: compute domain decomposition with "//& 
    2620       &               TRIM(fct_str(td_mpp%i_niproc))//" x "//& 
    2621       &               TRIM(fct_str(td_mpp%i_njproc))//" processors") 
    2622       ! maximum size of sub domain 
    2623       il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (td_mpp%i_niproc-1))/ & 
    2624       &           td_mpp%i_niproc) + 2*td_mpp%i_preci 
    2625       il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (td_mpp%i_njproc-1))/ & 
    2626       &           td_mpp%i_njproc) + 2*td_mpp%i_precj 
    2627  
    2628       il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, td_mpp%i_niproc) 
    2629       il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, td_mpp%i_njproc) 
    2630       IF( il_resti == 0 ) il_resti = td_mpp%i_niproc 
    2631       IF( il_restj == 0 ) il_restj = td_mpp%i_njproc 
    2632  
    2633       ! compute dimension of each sub domain 
    2634       ALLOCATE( il_nlci(td_mpp%i_niproc,td_mpp%i_njproc) ) 
    2635       ALLOCATE( il_nlcj(td_mpp%i_niproc,td_mpp%i_njproc) ) 
    2636  
    2637       il_nlci( 1 : il_resti                , : ) = il_isize 
    2638       il_nlci( il_resti+1 : td_mpp%i_niproc, : ) = il_isize-1 
    2639  
    2640       il_nlcj( : , 1 : il_restj                ) = il_jsize 
    2641       il_nlcj( : , il_restj+1 : td_mpp%i_njproc) = il_jsize-1 
    2642  
    2643       ! compute first index of each sub domain 
    2644       ALLOCATE( il_impp(td_mpp%i_niproc,td_mpp%i_njproc) ) 
    2645       ALLOCATE( il_jmpp(td_mpp%i_niproc,td_mpp%i_njproc) ) 
    2646  
    2647       il_impp(:,:)=1 
    2648       il_jmpp(:,:)=1 
    2649  
    2650       DO jj=1,td_mpp%i_njproc 
    2651          DO ji=2,td_mpp%i_niproc 
    2652             il_impp(ji,jj)=il_impp(ji-1,jj)+il_nlci(ji-1,jj)-2*td_mpp%i_preci 
     2907      CALL logger_debug( "MPP CREATE LAYOUT: create domain decomposition with "//& 
     2908      &               TRIM(fct_str(td_lay%i_niproc))//" x "//& 
     2909      &               TRIM(fct_str(td_lay%i_njproc))//" = "//& 
     2910      &               TRIM(fct_str(td_lay%i_nsea))//" processors") 
     2911 
     2912      IF( lm_layout )THEN 
     2913         WRITE(im_iumout,*) ' choix optimum' 
     2914         WRITE(im_iumout,*) ' =============' 
     2915         WRITE(im_iumout,*) 
     2916         ! print info  
     2917         WRITE(im_iumout,*) ' ' 
     2918         WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc 
     2919         WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj 
     2920 
     2921 
     2922         WRITE(im_iumout,*) ' nombre de processeurs       ',td_lay%i_niproc*td_lay%i_njproc 
     2923         WRITE(im_iumout,*) ' nombre de processeurs mer   ',td_lay%i_nsea 
     2924         WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland 
     2925         WRITE(im_iumout,*) ' moyenne de recouvrement     ',td_lay%i_mean 
     2926         WRITE(im_iumout,*) ' minimum de recouvrement     ',td_lay%i_min 
     2927         WRITE(im_iumout,*) ' maximum de recouvrement     ',td_lay%i_max 
     2928      ENDIF 
     2929 
     2930      td_mpp%i_niproc=td_lay%i_niproc 
     2931      td_mpp%i_njproc=td_lay%i_njproc 
     2932      !td_mpp%i_nproc =td_lay%i_nsea 
     2933 
     2934      IF( td_mpp%i_niproc*td_mpp%i_njproc == td_lay%i_nsea )THEN 
     2935         IF( td_lay%i_nsea == 1 )THEN 
     2936            td_mpp%c_dom='full' 
     2937         ELSE 
     2938            td_mpp%c_dom='nooverlap' 
     2939         ENDIF 
     2940      ELSE 
     2941            td_mpp%c_dom='noextra' 
     2942      ENDIF 
     2943       
     2944      jk=0 
     2945      DO jj=1,td_lay%i_njproc 
     2946         DO ji=1,td_lay%i_niproc 
     2947 
     2948            IF( td_lay%i_msk(ji,jj) >= 1 )THEN 
     2949 
     2950               ! get processor file name 
     2951               cl_file=file_rename(td_mpp%c_name,jk) 
     2952               ! initialise file structure 
     2953               tl_proc=file_init(cl_file,td_mpp%c_type) 
     2954 
     2955               ! procesor id 
     2956               tl_proc%i_pid=jk 
     2957 
     2958               tl_att=att_init("DOMAIN_number",tl_proc%i_pid) 
     2959               CALL file_add_att(tl_proc, tl_att) 
     2960 
     2961               ! processor indices 
     2962               tl_proc%i_iind=ji 
     2963               tl_proc%i_jind=jj 
     2964 
     2965               ! fill processor dimension and first indices 
     2966               tl_proc%i_impp = td_lay%i_impp(ji,jj) 
     2967               tl_proc%i_jmpp = td_lay%i_jmpp(ji,jj) 
     2968 
     2969               tl_proc%i_lci  = td_lay%i_lci(ji,jj) 
     2970               tl_proc%i_lcj  = td_lay%i_lcj(ji,jj) 
     2971 
     2972               ! compute first and last indoor indices 
     2973                
     2974               ! west boundary 
     2975               IF( ji == 1 )THEN 
     2976                  tl_proc%i_ldi = 1  
     2977                  tl_proc%l_ctr = .TRUE. 
     2978               ELSE 
     2979                  tl_proc%i_ldi = 1 + td_mpp%i_preci 
     2980               ENDIF 
     2981 
     2982               ! south boundary 
     2983               IF( jj == 1 )THEN 
     2984                  tl_proc%i_ldj = 1  
     2985                  tl_proc%l_ctr = .TRUE. 
     2986               ELSE 
     2987                  tl_proc%i_ldj = 1 + td_mpp%i_precj 
     2988               ENDIF 
     2989 
     2990               ! east boundary 
     2991               IF( ji == td_mpp%i_niproc )THEN 
     2992                  tl_proc%i_lei = td_lay%i_lci(ji,jj) 
     2993                  tl_proc%l_ctr = .TRUE. 
     2994               ELSE 
     2995                  tl_proc%i_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci 
     2996               ENDIF 
     2997 
     2998               ! north boundary 
     2999               IF( jj == td_mpp%i_njproc )THEN 
     3000                  tl_proc%i_lej = td_lay%i_lcj(ji,jj) 
     3001                  tl_proc%l_ctr = .TRUE. 
     3002               ELSE 
     3003                  tl_proc%i_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj 
     3004               ENDIF 
     3005 
     3006               ! add processor to mpp structure 
     3007               CALL mpp__add_proc(td_mpp, tl_proc) 
     3008 
     3009               ! clean 
     3010               CALL att_clean(tl_att) 
     3011               CALL file_clean(tl_proc) 
     3012 
     3013               ! update proc number 
     3014               jk=jk+1 !ji+(jj-1)*td_lay%i_niproc 
     3015 
     3016            ENDIF 
    26533017         ENDDO 
    26543018      ENDDO 
    26553019 
    2656       DO jj=2,td_mpp%i_njproc 
    2657          DO ji=1,td_mpp%i_niproc 
    2658             il_jmpp(ji,jj)=il_jmpp(ji,jj-1)+il_nlcj(ji,jj-1)-2*td_mpp%i_precj 
    2659          ENDDO 
    2660       ENDDO  
    2661  
    2662       DO jj=1,td_mpp%i_njproc 
    2663          DO ji=1,td_mpp%i_niproc 
    2664  
    2665             jk=ji+(jj-1)*td_mpp%i_niproc 
    2666  
    2667             ! get processor file name 
    2668             cl_file=file_rename(td_mpp%c_name,jk) 
    2669             ! initialise file structure 
    2670             tl_proc=file_init(cl_file,td_mpp%c_type) 
    2671  
    2672             ! procesor id 
    2673             tl_proc%i_pid=jk 
    2674  
    2675             tl_att=att_init("DOMAIN_number",tl_proc%i_pid) 
    2676             CALL file_add_att(tl_proc, tl_att) 
    2677  
    2678             ! processor indices 
    2679             tl_proc%i_iind=ji 
    2680             tl_proc%i_jind=jj 
    2681  
    2682             ! fill processor dimension and first indices 
    2683             tl_proc%i_impp = il_impp(ji,jj) 
    2684             tl_proc%i_jmpp = il_jmpp(ji,jj) 
    2685  
    2686             tl_att=att_init( "DOMAIN_poistion_first", & 
    2687             &                (/tl_proc%i_impp, tl_proc%i_jmpp/) ) 
    2688             CALL file_add_att(tl_proc, tl_att) 
    2689  
    2690             tl_proc%i_lci  = il_nlci(ji,jj) 
    2691             tl_proc%i_lcj  = il_nlcj(ji,jj) 
    2692  
    2693             tl_att=att_init( "DOMAIN_poistion_last", & 
    2694             &                (/tl_proc%i_lci, tl_proc%i_lcj/) ) 
    2695             CALL file_add_att(tl_proc, tl_att) 
    2696  
    2697             ! compute first and last indoor indices 
    2698              
    2699             ! west boundary 
    2700             IF( ji == 1 )THEN 
    2701                tl_proc%i_ldi = 1  
    2702                tl_proc%l_ctr = .TRUE. 
    2703             ELSE 
    2704                tl_proc%i_ldi = 1 + td_mpp%i_preci 
    2705             ENDIF 
    2706  
    2707             ! south boundary 
    2708             IF( jj == 1 )THEN 
    2709                tl_proc%i_ldj = 1  
    2710                tl_proc%l_ctr = .TRUE. 
    2711             ELSE 
    2712                tl_proc%i_ldj = 1 + td_mpp%i_precj 
    2713             ENDIF 
    2714  
    2715             ! east boundary 
    2716             IF( ji == td_mpp%i_niproc )THEN 
    2717                tl_proc%i_lei = il_nlci(ji,jj) 
    2718                tl_proc%l_ctr = .TRUE. 
    2719             ELSE 
    2720                tl_proc%i_lei = il_nlci(ji,jj) - td_mpp%i_preci 
    2721             ENDIF 
    2722  
    2723             ! north boundary 
    2724             IF( jj == td_mpp%i_njproc )THEN 
    2725                tl_proc%i_lej = il_nlcj(ji,jj) 
    2726                tl_proc%l_ctr = .TRUE. 
    2727             ELSE 
    2728                tl_proc%i_lej = il_nlcj(ji,jj) - td_mpp%i_precj 
    2729             ENDIF 
    2730  
    2731             tl_att=att_init( "DOMAIN_halo_size_start", & 
    2732             &                (/tl_proc%i_ldi, tl_proc%i_ldj/) ) 
    2733             CALL file_add_att(tl_proc, tl_att) 
    2734             tl_att=att_init( "DOMAIN_halo_size_end", & 
    2735             &                (/tl_proc%i_ldi, tl_proc%i_ldj/) ) 
    2736             CALL file_add_att(tl_proc, tl_att) 
    2737  
    2738             ! add processor to mpp structure 
    2739             CALL mpp__add_proc(td_mpp, tl_proc) 
    2740  
    2741             ! clean 
    2742             CALL att_clean(tl_att) 
    2743             CALL file_clean(tl_proc) 
    2744  
    2745          ENDDO 
    2746       ENDDO 
    2747  
    2748       DEALLOCATE( il_impp, il_jmpp ) 
    2749       DEALLOCATE( il_nlci, il_nlcj ) 
    2750  
    2751    END SUBROUTINE mpp__compute 
     3020   END SUBROUTINE mpp__create_layout 
    27523021   !------------------------------------------------------------------- 
    27533022   !> @brief  
    2754    !>  This subroutine remove land processor from domain decomposition. 
    2755    !> 
     3023   !>  This subroutine optimize the number of sub domain to be used, given mask. 
     3024   !> @details 
     3025   !>  Actually it get the domain decomposition with the most land  
     3026   !>  processors removed. 
     3027   !>  If no land processor could be removed, it get the decomposition with the 
     3028   !>  most sea processors. 
     3029   ! 
    27563030   !> @author J.Paul 
    27573031   !> @date November, 2013 - Initial version 
    2758    !> 
     3032   !> @date October, 2015 
     3033   !> - improve way to compute domain layout  
     3034   !> @date February, 2016 
     3035   !> - new criteria for domain layout in case no land proc 
     3036   ! 
    27593037   !> @param[inout] td_mpp mpp strcuture 
    2760    !> @param[in] id_mask   sub domain mask (sea=1, land=0) 
    2761    !------------------------------------------------------------------- 
    2762    SUBROUTINE mpp__del_land( td_mpp, id_mask ) 
     3038   !> @param[in] id_mask   sub domain mask (sea=1, land=0)  
     3039   !> @pram[in] id_nproc maximum number of processor to be used 
     3040   !------------------------------------------------------------------- 
     3041   SUBROUTINE mpp__optimiz( td_mpp, id_mask, id_nproc ) 
    27633042      IMPLICIT NONE 
    27643043      ! Argument 
    27653044      TYPE(TMPP),                  INTENT(INOUT) :: td_mpp 
    27663045      INTEGER(i4), DIMENSION(:,:), INTENT(IN)    :: id_mask 
    2767  
    2768       ! loop indices 
    2769       INTEGER(i4) :: jk 
    2770       !---------------------------------------------------------------- 
    2771  
    2772       IF( ASSOCIATED(td_mpp%t_proc) )THEN 
    2773          jk=1 
    2774          DO WHILE( jk <= td_mpp%i_nproc ) 
    2775             IF( mpp__land_proc(td_mpp, jk, id_mask(:,:)) )THEN 
    2776                CALL mpp__del_proc(td_mpp, jk) 
    2777             ELSE 
    2778                jk=jk+1 
    2779             ENDIF 
    2780          ENDDO 
    2781       ELSE 
    2782          CALL logger_error("MPP DEL LAND: domain decomposition not define.") 
    2783       ENDIF 
    2784  
    2785    END SUBROUTINE mpp__del_land 
    2786    !------------------------------------------------------------------- 
    2787    !> @brief  
    2788    !>  This subroutine optimize the number of sub domain to be used, given mask. 
    2789    !> @details 
    2790    !>  Actually it get the domain decomposition with the most land  
    2791    !>  processor removed. 
    2792    ! 
    2793    !> @author J.Paul 
    2794    !> @date November, 2013 - Initial version 
    2795    ! 
    2796    !> @param[inout] td_mpp mpp strcuture 
    2797    !> @param[in] id_mask   sub domain mask (sea=1, land=0)  
    2798    !------------------------------------------------------------------- 
    2799    SUBROUTINE mpp__optimiz( td_mpp, id_mask ) 
    2800       IMPLICIT NONE 
    2801       ! Argument 
    2802       TYPE(TMPP),                  INTENT(INOUT) :: td_mpp 
    2803       INTEGER(i4), DIMENSION(:,:), INTENT(IN)    :: id_mask 
     3046      INTEGER(i4)                , INTENT(IN)    :: id_nproc 
    28043047 
    28053048      ! local variable 
    2806       TYPE(TMPP)  :: tl_mpp 
    2807       INTEGER(i4) :: il_maxproc 
    2808  
    2809       TYPE(TFILE), DIMENSION(:), ALLOCATABLE :: tl_proc 
     3049      TYPE(TLAY) :: tl_lay 
     3050      TYPE(TLAY) :: tl_sav 
     3051 
     3052      REAL(dp)   :: dl_min 
     3053      REAL(dp)   :: dl_max 
     3054      REAL(dp)   :: dl_ratio 
     3055      REAL(dp)   :: dl_sav 
     3056 
    28103057      ! loop indices 
    28113058      INTEGER(i4) :: ji 
     
    28143061 
    28153062      CALL logger_trace("MPP OPTIMIZ: look for best domain decomposition") 
    2816       tl_mpp=mpp_copy(td_mpp) 
    2817  
    2818       ! save maximum number of processor to be used 
    2819       il_maxproc=td_mpp%i_nproc 
     3063      dl_sav=0 
    28203064      !  
    2821       td_mpp%i_nproc=0 
    2822       DO ji=1,il_maxproc 
    2823          DO jj=1,il_maxproc 
    2824  
    2825             ! clean mpp processor 
    2826             IF( ASSOCIATED(tl_mpp%t_proc) )THEN 
    2827                CALL file_clean(tl_mpp%t_proc(:)) 
    2828                DEALLOCATE(tl_mpp%t_proc) 
    2829             ENDIF 
    2830  
    2831             ! compute domain decomposition 
    2832             tl_mpp%i_niproc=ji 
    2833             tl_mpp%i_njproc=jj 
    2834              
    2835             CALL mpp__compute( tl_mpp ) 
    2836              
    2837             ! remove land sub domain 
    2838             CALL mpp__del_land( tl_mpp, id_mask ) 
    2839  
    2840             CALL logger_info("MPP OPTIMIZ: number of processor "//& 
    2841             &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
    2842             &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
    2843             IF( tl_mpp%i_nproc > td_mpp%i_nproc .AND. & 
    2844             &   tl_mpp%i_nproc <= il_maxproc )THEN 
    2845                ! save optimiz decomposition  
    2846  
    2847                CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 
    2848                &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
    2849                &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
    2850  
    2851                ! clean mpp 
    2852                CALL mpp_clean(td_mpp) 
    2853  
    2854                ! save processor array 
    2855                ALLOCATE( tl_proc(tl_mpp%i_nproc) ) 
    2856                tl_proc(:)=file_copy(tl_mpp%t_proc(:)) 
    2857  
    2858                ! remove pointer on processor array 
    2859                CALL file_clean(tl_mpp%t_proc(:)) 
    2860                DEALLOCATE(tl_mpp%t_proc) 
    2861   
    2862                ! save data except processor array 
    2863                td_mpp=mpp_copy(tl_mpp) 
    2864  
    2865                ! save processor array 
    2866                ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc) ) 
    2867                td_mpp%t_proc(:)=file_copy(tl_proc(:)) 
    2868  
    2869                ! clean 
    2870                CALL file_clean( tl_proc(:) ) 
    2871                DEALLOCATE(tl_proc) 
    2872  
    2873             ENDIF 
    2874              
     3065      DO ji=1,id_nproc 
     3066         DO jj=1,id_nproc 
     3067 
     3068            ! compute domain layout 
     3069            tl_lay=layout__init( td_mpp, id_mask, ji,jj ) 
     3070            IF( tl_lay%i_nsea <= id_nproc )THEN 
     3071 
     3072               IF( ASSOCIATED(tl_sav%i_lci) )THEN 
     3073                  IF( tl_sav%i_nland /= 0 )THEN 
     3074                     ! look for layout with most land proc 
     3075                     IF( tl_lay%i_nland > tl_sav%i_nland    .OR. & 
     3076                     &   ( tl_lay%i_nland == tl_sav%i_nland .AND. & 
     3077                     &     tl_lay%i_min   >  tl_sav%i_min   ) )THEN 
     3078                        ! save optimiz layout 
     3079                        CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 
     3080                        &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
     3081                        &   TRIM(fct_str(tl_lay%i_nsea)) ) 
     3082 
     3083                        tl_sav=layout__copy(tl_lay) 
     3084                     ENDIF 
     3085                  ELSE ! tl_sav%i_nland == 0 
     3086                     ! look for layout with most sea proc  
     3087                     ! and "square" cell  
     3088                     dl_min=MIN(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1)) 
     3089                     dl_max=MAX(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1)) 
     3090                     dl_ratio=dl_min/dl_max 
     3091                     IF( tl_lay%i_nsea > tl_sav%i_nsea    .OR. & 
     3092                     &   ( tl_lay%i_nsea == tl_sav%i_nsea .AND. & 
     3093                     &     dl_ratio   >  dl_sav ) )THEN 
     3094                        ! save optimiz layout 
     3095                        CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 
     3096                        &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
     3097                        &   TRIM(fct_str(tl_lay%i_nsea)) ) 
     3098 
     3099                        tl_sav=layout__copy(tl_lay) 
     3100                        dl_sav=dl_ratio 
     3101                     ENDIF 
     3102                  ENDIF 
     3103               ELSE 
     3104                  ! init tl_sav 
     3105                  tl_sav=layout__copy(tl_lay) 
     3106 
     3107                  dl_min=MIN(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1)) 
     3108                  dl_max=MAX(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1)) 
     3109                  dl_sav=dl_min/dl_max 
     3110               ENDIF 
     3111 
     3112            ENDIF 
     3113 
     3114            ! clean 
     3115            CALL layout__clean( tl_lay ) 
     3116 
    28753117         ENDDO 
    28763118      ENDDO 
    28773119 
     3120      ! create mpp domain layout 
     3121      CALL mpp__create_layout(td_mpp, tl_sav) 
     3122 
    28783123      ! clean 
    2879       CALL mpp_clean(tl_mpp) 
     3124      CALL layout__clean( tl_sav ) 
    28803125 
    28813126   END SUBROUTINE mpp__optimiz 
    2882    !------------------------------------------------------------------- 
    2883    !> @brief 
    2884    !>    This function check if processor is a land processor. 
    2885    !> 
    2886    !> @author J.Paul 
    2887    !> @date November, 2013 - Initial version 
    2888    !> 
    2889    !> @param[in] td_mpp    mpp strcuture 
    2890    !> @param[in] id_proc   processor id 
    2891    !> @param[in] id_mask   sub domain mask (sea=1, land=0) 
    2892    !------------------------------------------------------------------- 
    2893    LOGICAL FUNCTION mpp__land_proc( td_mpp , id_proc, id_mask ) 
    2894       IMPLICIT NONE 
    2895       ! Argument 
    2896       TYPE(TMPP),                  INTENT(IN) :: td_mpp 
    2897       INTEGER(i4),                 INTENT(IN) :: id_proc 
    2898       INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask 
    2899  
    2900       ! local variable 
    2901       INTEGER(i4), DIMENSION(2) :: il_shape 
    2902       !---------------------------------------------------------------- 
    2903  
    2904       CALL logger_trace("MPP LAND PROC: check processor "//TRIM(fct_str(id_proc))//& 
    2905       &  " of mpp "//TRIM(td_mpp%c_name) ) 
    2906       mpp__land_proc=.FALSE. 
    2907       IF( ASSOCIATED(td_mpp%t_proc) )THEN 
    2908  
    2909          il_shape(:)=SHAPE(id_mask) 
    2910          IF( il_shape(1) /= td_mpp%t_dim(1)%i_len .OR. & 
    2911          &   il_shape(2) /= td_mpp%t_dim(2)%i_len )THEN 
    2912              CALL logger_debug("MPP LAND PROC: mask size ("//& 
    2913              &                  TRIM(fct_str(il_shape(1)))//","//& 
    2914              &                  TRIM(fct_str(il_shape(2)))//")") 
    2915              CALL logger_debug("MPP LAND PROC: domain size ("//& 
    2916              &                  TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//& 
    2917              &                  TRIM(fct_str(td_mpp%t_dim(2)%i_len))//")") 
    2918              CALL logger_error("MPP LAND PROC: mask and domain size differ") 
    2919          ELSE 
    2920             IF( ALL(id_mask( td_mpp%t_proc(id_proc)%i_impp +            & 
    2921             &                       td_mpp%t_proc(id_proc)%i_ldi - 1 : & 
    2922             &                td_mpp%t_proc(id_proc)%i_impp +            & 
    2923             &                       td_mpp%t_proc(id_proc)%i_lei - 1,  & 
    2924             &                td_mpp%t_proc(id_proc)%i_jmpp +            & 
    2925             &                       td_mpp%t_proc(id_proc)%i_ldj - 1 : & 
    2926             &                td_mpp%t_proc(id_proc)%i_jmpp +            & 
    2927             &                       td_mpp%t_proc(id_proc)%i_lej - 1)  & 
    2928             &      /= 1 ) )THEN 
    2929                ! land domain 
    2930                CALL logger_info("MPP LAND PROC: processor "//TRIM(fct_str(id_proc))//& 
    2931                &             " is land processor") 
    2932                mpp__land_proc=.TRUE. 
    2933             ENDIF 
    2934          ENDIF 
    2935  
    2936       ELSE 
    2937          CALL logger_error("MPP LAND PROC: domain decomposition not define.") 
    2938       ENDIF 
    2939  
    2940    END FUNCTION mpp__land_proc 
    29413127   !------------------------------------------------------------------- 
    29423128   !> @brief  
     
    31953381         SELECT CASE(TRIM(td_mpp%c_dom)) 
    31963382            CASE('full') 
    3197                il_i1 = 1 ; il_i2 = td_mpp%t_dim(1)%i_len 
    3198                il_j1 = 1 ; il_j2 = td_mpp%t_dim(2)%i_len 
    3199             CASE('overlap') 
    3200                 il_i1 = td_mpp%t_proc(id_procid)%i_impp 
    3201                 il_j1 = td_mpp%t_proc(id_procid)%i_jmpp 
    3202  
    3203                 il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1  
    3204                 il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1  
     3383               il_i1 = 1  
     3384               il_j1 = 1  
     3385 
     3386               il_i2 = td_mpp%t_dim(1)%i_len 
     3387               il_j2 = td_mpp%t_dim(2)%i_len 
     3388            CASE('noextra') 
     3389               il_i1 = td_mpp%t_proc(id_procid)%i_impp 
     3390               il_j1 = td_mpp%t_proc(id_procid)%i_jmpp 
     3391 
     3392               il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1  
     3393               il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1  
    32053394            CASE('nooverlap') 
    32063395               il_i1 = td_mpp%t_proc(id_procid)%i_impp + & 
     
    32143403               &        td_mpp%t_proc(id_procid)%i_lej - 1 
    32153404            CASE DEFAULT 
    3216                CALL logger_error("MPP GET PROC INDEX: invalid decomposition type.") 
     3405               CALL logger_error("MPP GET PROC INDEX: invalid "//& 
     3406                  &              "decomposition type.") 
    32173407         END SELECT 
    32183408 
     
    32643454               il_jsize = td_mpp%t_dim(2)%i_len 
    32653455 
    3266             CASE('overlap') 
     3456            CASE('noextra') 
    32673457 
    32683458                il_isize = td_mpp%t_proc(id_procid)%i_lci 
     
    33083498      IF( ASSOCIATED(td_mpp%t_proc) )THEN 
    33093499 
    3310          IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_niproc == 0 )THEN 
     3500         IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_njproc == 0 )THEN 
    33113501            CALL logger_info("MPP GET DOM: use indoor indices to get domain "//& 
    33123502            &             "decomposition type.") 
     
    33233513            &       td_mpp%t_proc(1)%i_lcj                     )     )THEN 
    33243514 
    3325                td_mpp%c_dom='overlap' 
     3515               td_mpp%c_dom='noextra' 
    33263516 
    33273517            ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len ==                     & 
     
    33683558               td_mpp%c_dom='nooverlap' 
    33693559            ELSE 
    3370                td_mpp%c_dom='overlap' 
     3560               td_mpp%c_dom='noextra' 
    33713561            ENDIF 
    33723562 
     
    33863576   !> @author J.Paul 
    33873577   !> @date November, 2013 - Initial Version 
     3578   !> @date September 2015 
     3579   !> - do not check used dimension here 
    33883580   !> 
    33893581   !> @param[in] td_mpp mpp structure 
     
    33983590 
    33993591      ! local variable 
     3592      CHARACTER(LEN=lc) :: cl_dim 
     3593      LOGICAL :: ll_error 
     3594      LOGICAL :: ll_warn 
     3595 
     3596      INTEGER(i4)       :: il_ind 
    34003597 
    34013598      ! loop indices 
     
    34033600      !---------------------------------------------------------------- 
    34043601      mpp__check_var_dim=.TRUE. 
     3602 
    34053603      ! check used dimension  
    3406       IF( ANY( td_var%t_dim(:)%l_use .AND. & 
    3407       &        td_var%t_dim(:)%i_len /= td_mpp%t_dim(:)%i_len) )THEN 
     3604      ll_error=.FALSE. 
     3605      ll_warn=.FALSE. 
     3606      DO ji=1,ip_maxdim 
     3607         il_ind=dim_get_index( td_mpp%t_dim(:), & 
     3608         &                     TRIM(td_var%t_dim(ji)%c_name), & 
     3609         &                     TRIM(td_var%t_dim(ji)%c_sname)) 
     3610         IF( il_ind /= 0 )THEN 
     3611            IF( td_var%t_dim(ji)%l_use  .AND. & 
     3612            &   td_mpp%t_dim(il_ind)%l_use .AND. & 
     3613            &   td_var%t_dim(ji)%i_len /= td_mpp%t_dim(il_ind)%i_len )THEN 
     3614               IF( INDEX( TRIM(td_var%c_axis), & 
     3615               &          TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN 
     3616                  ll_warn=.TRUE. 
     3617               ELSE 
     3618                  ll_error=.TRUE. 
     3619               ENDIF 
     3620            ENDIF 
     3621         ENDIF 
     3622      ENDDO 
     3623 
     3624      IF( ll_error )THEN 
     3625 
     3626         cl_dim='(/' 
     3627         DO ji = 1, td_mpp%i_ndim 
     3628            IF( td_mpp%t_dim(ji)%l_use )THEN 
     3629               cl_dim=TRIM(cl_dim)//& 
     3630               &  TRIM(fct_upper(td_mpp%t_dim(ji)%c_sname))//':'//& 
     3631               &  TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//',' 
     3632            ENDIF 
     3633         ENDDO 
     3634         cl_dim=TRIM(cl_dim)//'/)' 
     3635         CALL logger_debug( " mpp dimension: "//TRIM(cl_dim) ) 
     3636 
     3637         cl_dim='(/' 
     3638         DO ji = 1, td_var%i_ndim 
     3639            IF( td_var%t_dim(ji)%l_use )THEN 
     3640               cl_dim=TRIM(cl_dim)//& 
     3641               &  TRIM(fct_upper(td_var%t_dim(ji)%c_sname))//':'//& 
     3642               &  TRIM(fct_str(td_var%t_dim(ji)%i_len))//',' 
     3643            ENDIF 
     3644         ENDDO 
     3645         cl_dim=TRIM(cl_dim)//'/)' 
     3646         CALL logger_debug( " variable dimension: "//TRIM(cl_dim) ) 
    34083647 
    34093648         mpp__check_var_dim=.FALSE. 
    34103649 
    3411          CALL logger_debug( & 
    3412          &  " mpp dimension: "//TRIM(fct_str(td_mpp%i_ndim))//& 
    3413          &  " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) ) 
    3414          DO ji = 1, ip_maxdim 
    3415             CALL logger_debug( & 
    3416             &  "MPP CHECK DIM: for dimension "//& 
    3417             &  TRIM(td_mpp%t_dim(ji)%c_name)//& 
    3418             &  ", mpp length: "//& 
    3419             &  TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//& 
    3420             &  ", variable length: "//& 
    3421             &  TRIM(fct_str(td_var%t_dim(ji)%i_len))//& 
    3422             &  ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use))) 
    3423          ENDDO 
    3424  
    34253650         CALL logger_error( & 
    3426          &  "MPP CHECK DIM: variable and mpp dimension differ"//& 
     3651         &  " MPP CHECK VAR DIM: variable and file dimension differ"//& 
    34273652         &  " for variable "//TRIM(td_var%c_name)//& 
    3428          &  " and mpp "//TRIM(td_mpp%c_name)) 
     3653         &  " and file "//TRIM(td_mpp%c_name)) 
     3654 
     3655      ELSEIF( ll_warn )THEN 
     3656         CALL logger_warn( & 
     3657         &  " MPP CHECK VAR DIM: variable and file dimension differ"//& 
     3658         &  " for variable "//TRIM(td_var%c_name)//& 
     3659         &  " and file "//TRIM(td_mpp%c_name)//". you should use"//& 
     3660         &  " var_check_dim to remove useless dimension.") 
     3661      ELSE 
     3662 
     3663         IF( td_var%i_ndim >  td_mpp%i_ndim )THEN 
     3664            CALL logger_info("MPP CHECK VAR DIM: variable "//& 
     3665            &  TRIM(td_var%c_name)//" use more dimension than file "//& 
     3666            &  TRIM(td_mpp%c_name)//" do until now.") 
     3667         ENDIF 
    34293668 
    34303669      ENDIF 
     
    35833822      ENDIF 
    35843823   END FUNCTION mpp_recombine_var 
     3824   !------------------------------------------------------------------- 
     3825   !> @brief This subroutine read subdomain indices defined with halo 
     3826   !> (NEMO netcdf way) 
     3827   !> 
     3828   !> @author J.Paul 
     3829   !> @date January, 2016 - Initial Version 
     3830   !> 
     3831   !> @param[inout] td_file   mpp structure 
     3832   !------------------------------------------------------------------- 
     3833   SUBROUTINE mpp__read_halo(td_file, td_dimglo)  
     3834   IMPLICIT NONE 
     3835      ! Argument       
     3836      TYPE(TFILE)              , INTENT(INOUT) :: td_file 
     3837      TYPE(TDIM) , DIMENSION(:), INTENT(IN   ) :: td_dimglo 
     3838 
     3839      ! local variable 
     3840      INTEGER(i4)       :: il_attid 
     3841      INTEGER(i4)       :: il_ifirst 
     3842      INTEGER(i4)       :: il_jfirst 
     3843      INTEGER(i4)       :: il_ilast 
     3844      INTEGER(i4)       :: il_jlast 
     3845      INTEGER(i4)       :: il_ihalostart 
     3846      INTEGER(i4)       :: il_jhalostart 
     3847      INTEGER(i4)       :: il_ihaloend 
     3848      INTEGER(i4)       :: il_jhaloend 
     3849 
     3850      CHARACTER(LEN=lc) :: cl_dom 
     3851      !---------------------------------------------------------------- 
     3852 
     3853      ! DOMAIN_position_first 
     3854      il_attid = 0 
     3855      IF( ASSOCIATED(td_file%t_att) )THEN 
     3856         il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" ) 
     3857      ENDIF 
     3858      IF( il_attid /= 0 )THEN 
     3859         il_ifirst = INT(td_file%t_att(il_attid)%d_value(1)) 
     3860         il_jfirst = INT(td_file%t_att(il_attid)%d_value(2)) 
     3861      ELSE 
     3862         il_ifirst = 1 
     3863         il_jfirst = 1 
     3864      ENDIF 
     3865 
     3866      ! DOMAIN_position_last 
     3867      il_attid = 0 
     3868      IF( ASSOCIATED(td_file%t_att) )THEN 
     3869         il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" ) 
     3870      ENDIF 
     3871      IF( il_attid /= 0 )THEN 
     3872         il_ilast = INT(td_file%t_att(il_attid)%d_value(1)) 
     3873         il_jlast = INT(td_file%t_att(il_attid)%d_value(2)) 
     3874      ELSE 
     3875         il_ilast = td_file%t_dim(1)%i_len 
     3876         il_jlast = td_file%t_dim(2)%i_len 
     3877      ENDIF 
     3878 
     3879      ! DOMAIN_halo_size_start 
     3880      il_attid = 0 
     3881      IF( ASSOCIATED(td_file%t_att) )THEN 
     3882         il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" ) 
     3883      ENDIF 
     3884      IF( il_attid /= 0 )THEN 
     3885         il_ihalostart = INT(td_file%t_att(il_attid)%d_value(1)) 
     3886         il_jhalostart = INT(td_file%t_att(il_attid)%d_value(2)) 
     3887      ELSE 
     3888         il_ihalostart = 0 
     3889         il_jhalostart = 0 
     3890      ENDIF 
     3891 
     3892      ! DOMAIN_halo_size_end 
     3893      il_attid = 0 
     3894      IF( ASSOCIATED(td_file%t_att) )THEN 
     3895         il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" ) 
     3896      ENDIF 
     3897      IF( il_attid /= 0 )THEN 
     3898         il_ihaloend = INT(td_file%t_att(il_attid)%d_value(1)) 
     3899         il_jhaloend = INT(td_file%t_att(il_attid)%d_value(2)) 
     3900      ELSE 
     3901         il_ihaloend = 0 
     3902         il_jhaloend = 0 
     3903      ENDIF 
     3904 
     3905      IF( (td_dimglo(jp_I)%i_len == td_file%t_dim(jp_I)%i_len) .AND. & 
     3906        & (td_dimglo(jp_J)%i_len == td_file%t_dim(jp_J)%i_len) )THEN 
     3907         cl_dom='full' 
     3908      ELSEIF( il_ihalostart == 0 .AND. il_jhalostart == 0 .AND. & 
     3909           &  il_ihaloend == 0 .AND. il_jhaloend == 0 )THEN 
     3910         cl_dom='nooverlap' 
     3911      ELSE 
     3912         cl_dom='noextra' 
     3913      ENDIF 
     3914 
     3915      SELECT CASE(TRIM(cl_dom)) 
     3916         CASE('full') 
     3917            td_file%i_impp = il_ifirst  
     3918            td_file%i_jmpp = il_jfirst 
     3919            td_file%i_lci  = td_file%t_dim(jp_I)%i_len  
     3920            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len 
     3921            td_file%i_ldi  = il_ihalostart + 1 
     3922            td_file%i_ldj  = il_jhalostart + 1 
     3923            td_file%i_lei  = td_file%t_dim(jp_I)%i_len - il_ihaloend 
     3924            td_file%i_lej  = td_file%t_dim(jp_J)%i_len - il_jhaloend 
     3925         CASE('noextra') 
     3926            td_file%i_impp = il_ifirst 
     3927            td_file%i_jmpp = il_jfirst 
     3928            td_file%i_lci  = td_file%t_dim(jp_I)%i_len 
     3929            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len 
     3930            td_file%i_ldi  = il_ihalostart + 1 
     3931            td_file%i_ldj  = il_jhalostart + 1 
     3932            td_file%i_lei  = td_file%i_lci - il_ihaloend 
     3933            td_file%i_lej  = td_file%i_lcj - il_jhaloend 
     3934         CASE('nooverlap') !!!????? 
     3935            td_file%i_impp = il_ifirst 
     3936            td_file%i_jmpp = il_jfirst 
     3937            td_file%i_lci  = td_file%t_dim(jp_I)%i_len 
     3938            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len 
     3939            td_file%i_ldi  = 1 
     3940            td_file%i_ldj  = 1  
     3941            td_file%i_lei  = td_file%t_dim(jp_I)%i_len 
     3942            td_file%i_lej  = td_file%t_dim(jp_J)%i_len 
     3943      END SELECT 
     3944 
     3945   END SUBROUTINE mpp__read_halo 
     3946   !------------------------------------------------------------------- 
     3947   !> @brief This subroutine compute subdomain indices defined with halo 
     3948   !> (NEMO netcdf way) 
     3949   !> 
     3950   !> @author J.Paul 
     3951   !> @date January, 2016 - Initial Version 
     3952   !> 
     3953   !> @param[inout] td_mpp   mpp structure 
     3954   !------------------------------------------------------------------- 
     3955   SUBROUTINE mpp__compute_halo(td_mpp)  
     3956   IMPLICIT NONE 
     3957      ! Argument       
     3958      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp 
     3959 
     3960      ! local variable 
     3961      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ifirst 
     3962      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jfirst 
     3963      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ilast 
     3964      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jlast 
     3965      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihalostart 
     3966      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhalostart 
     3967      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihaloend 
     3968      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhaloend 
     3969 
     3970      TYPE(TATT)                             :: tl_att 
     3971 
     3972      ! loop indices 
     3973      INTEGER(i4) :: ji 
     3974      !---------------------------------------------------------------- 
     3975 
     3976      ALLOCATE( il_ifirst    (td_mpp%i_nproc) ) 
     3977      ALLOCATE( il_jfirst    (td_mpp%i_nproc) ) 
     3978 
     3979      ALLOCATE( il_ilast     (td_mpp%i_nproc) ) 
     3980      ALLOCATE( il_jlast     (td_mpp%i_nproc) ) 
     3981 
     3982      ALLOCATE( il_ihalostart(td_mpp%i_nproc) ) 
     3983      ALLOCATE( il_jhalostart(td_mpp%i_nproc) ) 
     3984 
     3985      ALLOCATE( il_ihaloend  (td_mpp%i_nproc) ) 
     3986      ALLOCATE( il_jhaloend  (td_mpp%i_nproc) ) 
     3987 
     3988      SELECT CASE(TRIM(td_mpp%c_dom)) 
     3989         CASE('full') 
     3990             
     3991            il_ifirst(:)=td_mpp%t_proc(:)%i_impp 
     3992            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp 
     3993             
     3994            il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%t_dim(jp_I)%i_len - 1 
     3995            il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%t_dim(jp_J)%i_len - 1 
     3996 
     3997            il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1 
     3998            il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1 
     3999             
     4000            il_ihaloend(:)=td_mpp%t_proc(:)%t_dim(jp_I)%i_len - td_mpp%t_proc(:)%i_lei 
     4001            il_jhaloend(:)=td_mpp%t_proc(:)%t_dim(jp_J)%i_len - td_mpp%t_proc(:)%i_lej 
     4002 
     4003         CASE('noextra') 
     4004             
     4005            il_ifirst(:)=td_mpp%t_proc(:)%i_impp 
     4006            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp 
     4007 
     4008            il_ilast(:) =td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lci - 1 
     4009            il_jlast(:) =td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lcj - 1 
     4010             
     4011            il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1 
     4012            il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1 
     4013             
     4014            il_ihaloend(:)=td_mpp%t_proc(:)%i_lci - td_mpp%t_proc(:)%i_lei 
     4015            il_jhaloend(:)=td_mpp%t_proc(:)%i_lcj - td_mpp%t_proc(:)%i_lej 
     4016 
     4017         CASE('nooverlap') 
     4018 
     4019            il_ifirst(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_ldi - 1 
     4020            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_ldj - 1 
     4021 
     4022            il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lei - 1 
     4023            il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lej - 1 
     4024 
     4025            il_ihalostart(:)=0 
     4026            il_jhalostart(:)=0 
     4027 
     4028            il_ihaloend(:)=0 
     4029            il_jhaloend(:)=0 
     4030 
     4031         CASE DEFAULT 
     4032            CALL logger_fatal("MPP INIT: invalid "//& 
     4033            &              "decomposition type.")                      
     4034      END SELECT 
     4035 
     4036      DO ji=1,td_mpp%i_nproc 
     4037         tl_att=att_init( "DOMAIN_position_first", & 
     4038         &                (/ il_ifirst(ji), il_jfirst(ji) /) ) 
     4039         CALL file_move_att(td_mpp%t_proc(ji), tl_att)       
     4040 
     4041         tl_att=att_init( "DOMAIN_position_last", & 
     4042         &                (/ il_ilast(ji), il_jlast(ji) /) ) 
     4043         CALL file_move_att(td_mpp%t_proc(ji), tl_att) 
     4044 
     4045         tl_att=att_init( "DOMAIN_halo_size_start", & 
     4046         &                (/ il_ihalostart(ji), il_jhalostart(ji) /) ) 
     4047         CALL file_move_att( td_mpp%t_proc(ji), tl_att)                
     4048 
     4049         tl_att=att_init( "DOMAIN_halo_size_end", & 
     4050         &                (/ il_ihaloend(ji), il_jhaloend(ji) /) ) 
     4051         CALL file_move_att( td_mpp%t_proc(ji), tl_att) 
     4052      ENDDO 
     4053 
     4054      DEALLOCATE( il_ifirst    ) 
     4055      DEALLOCATE( il_jfirst    ) 
     4056  
     4057      DEALLOCATE( il_ilast     ) 
     4058      DEALLOCATE( il_jlast     ) 
     4059  
     4060      DEALLOCATE( il_ihalostart) 
     4061      DEALLOCATE( il_jhalostart) 
     4062 
     4063      DEALLOCATE( il_ihaloend  ) 
     4064      DEALLOCATE( il_jhaloend  ) 
     4065 
     4066      !impp 
     4067      tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", td_mpp%t_proc(:)%i_impp) 
     4068      CALL mpp_move_att(td_mpp, tl_att) 
     4069 
     4070      tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", td_mpp%t_proc(:)%i_jmpp) 
     4071      CALL mpp_move_att(td_mpp, tl_att) 
     4072 
     4073      ! lci 
     4074      tl_att=att_init( "SUBDOMAIN_I_dimensions", td_mpp%t_proc(:)%i_lci) 
     4075      CALL mpp_move_att(td_mpp, tl_att) 
     4076 
     4077      tl_att=att_init( "SUBDOMAIN_J_dimensions", td_mpp%t_proc(:)%i_lcj) 
     4078      CALL mpp_move_att(td_mpp, tl_att) 
     4079 
     4080      ! ldi 
     4081      tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", td_mpp%t_proc(:)%i_ldi) 
     4082      CALL mpp_move_att(td_mpp, tl_att) 
     4083 
     4084      tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", td_mpp%t_proc(:)%i_ldj) 
     4085      CALL mpp_move_att(td_mpp, tl_att) 
     4086 
     4087      ! lei 
     4088      tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", td_mpp%t_proc(:)%i_lei) 
     4089      CALL mpp_move_att(td_mpp, tl_att) 
     4090 
     4091      tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", td_mpp%t_proc(:)%i_lej) 
     4092      CALL mpp_move_att(td_mpp, tl_att)          
     4093 
     4094      ! clean 
     4095      CALL att_clean(tl_att) 
     4096 
     4097   END SUBROUTINE mpp__compute_halo 
    35854098END MODULE mpp 
    35864099 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/multi.f90

    r5616 r6392  
    173173   !> @date July, 2015  
    174174   !> - check if variable to be read is in file 
     175   !> @date January, 2016 
     176   !> - read variable dimensions 
    175177   !> 
    176178   !> @param[in] cd_varfile   variable location information (from namelist)  
     
    187189 
    188190      ! local variable 
    189       CHARACTER(LEN=lc) :: cl_name 
    190       CHARACTER(LEN=lc) :: cl_lower 
    191       CHARACTER(LEN=lc) :: cl_file 
    192       CHARACTER(LEN=lc) :: cl_matrix 
    193  
    194       INTEGER(i4)       :: il_nvar 
    195       INTEGER(i4)       :: il_varid 
    196  
    197       LOGICAL           :: ll_dim 
    198  
    199       TYPE(TVAR)        :: tl_var 
    200  
    201       TYPE(TMPP)        :: tl_mpp 
     191      CHARACTER(LEN=lc)                :: cl_name 
     192      CHARACTER(LEN=lc)                :: cl_lower 
     193      CHARACTER(LEN=lc)                :: cl_file 
     194      CHARACTER(LEN=lc)                :: cl_matrix 
     195 
     196      INTEGER(i4)                      :: il_nvar 
     197      INTEGER(i4)                      :: il_varid 
     198 
     199      LOGICAL                          :: ll_dim 
     200 
     201      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim 
     202 
     203      TYPE(TVAR)                       :: tl_var 
     204 
     205      TYPE(TMPP)                       :: tl_mpp 
    202206 
    203207      ! loop indices 
     
    216220 
    217221         IF( LEN(TRIM(cl_file)) == lc )THEN 
    218             CALL logger_fatal("MULTI INIT: file name too long (==256)."//& 
    219             &  " check namelist.") 
     222            CALL logger_fatal("MULTI INIT: file name too long (>"//& 
     223            &          TRIM(fct_str(lc))//"). check namelist.") 
    220224         ENDIF 
    221225 
     
    243247                  !  
    244248                  tl_mpp=mpp_init( file_init(TRIM(cl_file)) ) 
    245  
    246249                  ! define variable 
    247250                  IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN 
     
    255258                     ENDIF 
    256259 
    257                      ! clean var 
     260                     ! get (global) variable dimension 
     261                     tl_dim(jp_I)=dim_copy(tl_mpp%t_dim(jp_I)) 
     262                     tl_dim(jp_J)=dim_copy(tl_mpp%t_dim(jp_J)) 
     263                     tl_dim(jp_K)=dim_copy(tl_mpp%t_proc(1)%t_var(il_varid)%t_dim(jp_K)) 
     264                     tl_dim(jp_L)=dim_copy(tl_mpp%t_proc(1)%t_var(il_varid)%t_dim(jp_L)) 
     265 
     266                     ! clean all varible 
    258267                     CALL mpp_del_var(tl_mpp) 
    259268 
    260                      tl_var=var_init(TRIM(cl_lower)) 
     269                     tl_var=var_init(TRIM(cl_lower), td_dim=tl_dim(:)) 
    261270 
    262271                     ! add variable 
     
    272281 
    273282                     DO jk=tl_mpp%t_proc(1)%i_nvar,1,-1 
    274                          
     283 
    275284                        ! check if variable is dimension 
    276285                        ll_dim=.FALSE. 
     
    379388      ! print file 
    380389      IF( td_multi%i_nmpp /= 0 .AND. ASSOCIATED(td_multi%t_mpp) )THEN 
    381          WRITE(*,'(/a,i3)') 'MULTI: total number of mpp: ',& 
     390         WRITE(*,'(/a,i3)') 'MULTI: total number of file(s): ',& 
    382391         &  td_multi%i_nmpp 
    383          WRITE(*,'(6x,a,i3)') ' total number of variable: ',& 
     392         WRITE(*,'(6x,a,i3)') ' total number of variable(s): ',& 
    384393         &  td_multi%i_nvar 
    385394         DO ji=1,td_multi%i_nmpp 
    386             WRITE(*,'(3x,3a)') 'MPP FILE ',TRIM(td_multi%t_mpp(ji)%c_name),& 
     395            WRITE(*,'(3x,3a)') 'FILE ',TRIM(td_multi%t_mpp(ji)%c_name),& 
    387396            & ' CONTAINS' 
    388397            DO jj=1,td_multi%t_mpp(ji)%t_proc(1)%i_nvar 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/phycst.f90

    r5608 r6392  
    1212! REVISION HISTORY: 
    1313!> @date November, 2013 - Initial Version 
     14!> @date September, 2015 
     15!> - add physical constant to compute meshmask 
    1416! 
    1517!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    2325   PUBLIC :: dp_pi      !< pi 
    2426   PUBLIC :: dp_eps     !< epsilon value 
    25    PUBLIC :: dp_rearth  !< earth radius (km) 
     27   PUBLIC :: dp_rearth  !< earth radius [m] 
    2628   PUBLIC :: dp_deg2rad !< degree to radian ratio  
    2729   PUBLIC :: dp_rad2deg !< radian to degree ratio  
    2830   PUBLIC :: dp_delta   !<   
     31   PUBLIC :: dp_omega   !< earth rotation parameter [s-1]  
     32   PUBLIC :: dp_day     !< day                                [s] 
     33   PUBLIC :: dp_siyea   !< sideral year                       [s] 
     34   PUBLIC :: dp_siday   !< sideral day                        [s] 
     35 
     36   REAL(wp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s] 
     37   REAL(wp), PUBLIC ::   rsiyea                 !: sideral year                       [s] 
     38   REAL(wp), PUBLIC ::   rsiday                 !: sideral day                        [s] 
    2939 
    3040   REAL(dp), PARAMETER :: dp_pi = 3.14159274101257_dp 
    3141   REAL(dp), PARAMETER :: dp_eps = EPSILON(1._dp) 
    32    REAL(dp), PARAMETER :: dp_rearth = 6871._dp 
     42   REAL(dp), PARAMETER :: dp_rearth = 6371229._dp 
    3343   REAL(dp), PARAMETER :: dp_deg2rad = dp_pi/180.0 
    3444   REAL(dp), PARAMETER :: dp_rad2deg = 180.0/dp_pi 
    3545 
     46   REAL(dp), PARAMETER :: dp_day = 24.*60.*60.      
     47   REAL(dp), PARAMETER :: dp_siyea = 365.25_wp * dp_day * & 
     48      &  2._wp * dp_pi / 6.283076_dp 
     49   REAL(dp), PARAMETER :: dp_siday = dp_day / ( 1._wp + dp_day / dp_siyea ) 
     50 
    3651   REAL(dp), PARAMETER :: dp_delta=1.e-6 
     52   REAL(dp), PARAMETER :: dp_omega= 2._dp * dp_pi / dp_siday 
    3753END MODULE phycst 
    3854 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/variable.f90

    r5616 r6392  
    285285!> @date July, 2015  
    286286!> - add subroutine var_chg_unit to change unit of output variable 
     287!> @date Spetember, 2015 
     288!> - manage useless (dummy) variable 
    287289! 
    288290!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    305307 
    306308   PUBLIC :: tg_varextra !< array of variable structure with extra information. 
     309 
     310   PRIVATE :: cm_dumvar  !< dummy variable array 
    307311 
    308312   ! function and subroutine 
     
    334338   PUBLIC :: var_chg_extra     !< read variable namelist information, and modify extra information. 
    335339   PUBLIC :: var_check_dim     !< check variable dimension expected 
     340   PUBLIC :: var_get_dummy     !< fill dummy variable array 
     341   PUBLIC :: var_is_dummy      !< check if variable is defined as dummy variable 
    336342 
    337343   PRIVATE :: var__init          ! initialize variable structure without array of value 
     
    445451                                                        !< fill when running var_def_extra()  
    446452 
     453   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumvar !< dummy variable 
     454 
    447455   INTERFACE var_init 
    448456      MODULE PROCEDURE var__init       ! initialize variable structure without array of value 
     
    66986706   !> given variable name or standard name.  
    66996707   !> 
    6700    !> @warning only variable read from file, have an id. 
    6701    !> 
    67026708   !> @author J.Paul 
    67036709   !> @date November, 2013 - Initial Version 
     6710   !> @date July, 2015 
     6711   !> - check long name 
    67046712   ! 
    67056713   !> @param[in] td_var       array of variable structure 
     
    67356743         ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.& 
    67366744         &    TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 
     6745             
     6746            var_get_id=td_var(ji)%i_id 
     6747            EXIT 
     6748 
     6749         ! look for variable long name 
     6750         ELSE IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 
     6751         &    TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 
    67376752             
    67386753            var_get_id=td_var(ji)%i_id 
     
    67756790      IF( ASSOCIATED(td_var%d_value) )THEN 
    67766791 
    6777          CALL logger_trace( "VAR GET MASK: create mask from variable "//& 
    6778          &               TRIM(td_var%c_name) ) 
     6792         CALL logger_debug( "VAR GET MASK: create mask from variable "//& 
     6793         &               TRIM(td_var%c_name)//", FillValue ="//& 
     6794         &               TRIM(fct_str(td_var%d_fill))) 
    67796795         var_get_mask(:,:,:)=1 
    67806796         WHERE( td_var%d_value(:,:,:,1) == td_var%d_fill ) 
     
    72797295 
    72807296      ! local variable 
     7297      CHARACTER(LEN=lc) :: cl_tmp 
     7298 
    72817299      INTEGER(i4)       :: il_ind 
     7300       
    72827301      TYPE(TATT)        :: tl_att 
    72837302 
    72847303      ! loop indices 
     7304      INTEGER(i4)       :: ji 
    72857305      !---------------------------------------------------------------- 
    72867306 
     
    73357355               td_var%c_axis=TRIM(tg_varextra(il_ind)%c_axis) 
    73367356               ! create attibute 
    7337                tl_att=att_init('axis',TRIM(td_var%c_axis)) 
    7338                CALL var_move_att(td_var, tl_att)                
     7357               IF( TRIM(fct_upper(td_var%c_name)) == TRIM(td_var%c_axis) )THEN 
     7358                  tl_att=att_init('axis',TRIM(td_var%c_axis)) 
     7359               ELSE 
     7360                  cl_tmp="" 
     7361                  DO ji=LEN(TRIM(td_var%c_axis)),1,-1 
     7362                     cl_tmp=TRIM(cl_tmp)//" "//TRIM(td_var%c_axis(ji:ji)) 
     7363                  ENDDO 
     7364                  tl_att=att_init('associate',TRIM(ADJUSTL(cl_tmp))) 
     7365               ENDIF 
     7366               CALL var_move_att(td_var, tl_att) 
    73397367            ENDIF 
    73407368 
     
    74027430            ENDIF 
    74037431 
     7432         ELSE 
     7433            CALL logger_warn("VAR GET EXTRA: no extra information on "//& 
     7434               &  "variable "//TRIM(td_var%c_name)//". you should define it"//& 
     7435               &  " (see variable.cfg).") 
    74047436         ENDIF 
    74057437 
     
    74257457   !> - change way to get information in namelist,  
    74267458   !> value follows string "min =" 
     7459   !> @date Feb, 2016 
     7460   !> - check character just after keyword 
    74277461   ! 
    74287462   !> @param[in] cd_name      variable name 
     
    74477481      ! loop indices 
    74487482      INTEGER(i4) :: ji 
     7483      INTEGER(i4) :: jj 
    74497484      !---------------------------------------------------------------- 
    74507485      ! init 
     
    74577492         il_ind=INDEX(TRIM(cl_tmp),'min') 
    74587493         IF( il_ind /= 0 )THEN 
    7459             cl_min=fct_split(cl_tmp,2,'=') 
    7460             EXIT 
     7494            ! check character just after 
     7495            jj=il_ind+LEN('min') 
     7496            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7497            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7498               cl_min=fct_split(cl_tmp,2,'=') 
     7499               EXIT 
     7500            ENDIF 
    74617501         ENDIF 
    74627502         ji=ji+1 
     
    74707510            &  TRIM(fct_str(var__get_min))//" for variable "//TRIM(cd_name) ) 
    74717511         ELSE 
    7472             CALL logger_error("VAR GET MIN: invalid minimum value for "//& 
    7473             &  "variable "//TRIM(cd_name)//". check namelist." ) 
     7512            CALL logger_error("VAR GET MIN: invalid minimum value ("//& 
     7513               & TRIM(cl_min)//") for variable "//TRIM(cd_name)//& 
     7514               & ". check namelist." ) 
    74747515         ENDIF 
    74757516      ENDIF 
     
    74897530   !> - change way to get information in namelist,  
    74907531   !> value follows string "max =" 
     7532   !> @date Feb, 2016 
     7533   !> - check character just after keyword 
    74917534   ! 
    74927535   !> @param[in] cd_name      variable name 
     
    75117554      ! loop indices 
    75127555      INTEGER(i4) :: ji 
     7556      INTEGER(i4) :: jj 
    75137557      !---------------------------------------------------------------- 
    75147558      ! init 
     
    75217565         il_ind=INDEX(TRIM(cl_tmp),'max') 
    75227566         IF( il_ind /= 0 )THEN 
    7523             cl_max=fct_split(cl_tmp,2,'=') 
    7524             EXIT 
     7567            ! check character just after 
     7568            jj=il_ind+LEN('max') 
     7569            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7570            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7571               cl_max=fct_split(cl_tmp,2,'=') 
     7572               EXIT 
     7573            ENDIF 
    75257574         ENDIF 
    75267575         ji=ji+1 
     
    75507599   !> @author J.Paul 
    75517600   !> @date June, 2015 - Initial Version 
     7601   !> @date Feb, 2016 
     7602   !> - check character just after keyword 
    75527603   ! 
    75537604   !> @param[in] cd_name      variable name 
     
    75747625      ! loop indices 
    75757626      INTEGER(i4) :: ji 
     7627      INTEGER(i4) :: jj 
    75767628      !---------------------------------------------------------------- 
    75777629      ! init 
     
    75847636         il_ind=INDEX(TRIM(cl_tmp),'unf') 
    75857637         IF( il_ind /= 0 )THEN 
    7586             cl_unf=fct_split(cl_tmp,2,'=') 
    7587             EXIT 
     7638            ! check character just after 
     7639            jj=il_ind+LEN('unf') 
     7640            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7641            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7642               cl_unf=fct_split(cl_tmp,2,'=') 
     7643               EXIT 
     7644            ENDIF 
    75887645         ENDIF 
    75897646         ji=ji+1 
     
    76267683   !> - change way to get information in namelist,  
    76277684   !> value follows string "int =" 
     7685   !> @date Feb, 2016 
     7686   !> - check character just after keyword 
    76287687   ! 
    76297688   !> @param[in] cd_name      variable name 
     
    76637722         il_ind=INDEX(TRIM(cl_tmp),'int') 
    76647723         IF( il_ind /= 0 )THEN 
    7665             cl_int=fct_split(cl_tmp,2,'=') 
    7666             EXIT 
     7724            ! check character just after 
     7725            jj=il_ind+LEN('int') 
     7726            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7727            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7728               cl_int=fct_split(cl_tmp,2,'=') 
     7729               EXIT 
     7730            ENDIF 
    76677731         ENDIF 
    76687732         ji=ji+1 
     
    77467810   !> - change way to get information in namelist,  
    77477811   !> value follows string "ext =" 
     7812   !> @date Feb, 2016 
     7813   !> - check character just after keyword 
    77487814   ! 
    77497815   !> @param[in] cd_name      variable name 
     
    77787844         il_ind=INDEX(TRIM(cl_tmp),'ext') 
    77797845         IF( il_ind /= 0 )THEN 
    7780             cl_ext=fct_split(cl_tmp,2,'=') 
    7781             EXIT 
     7846            ! check character just after 
     7847            jj=il_ind+LEN('ext') 
     7848            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7849            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7850               cl_ext=fct_split(cl_tmp,2,'=') 
     7851               EXIT 
     7852            ENDIF 
    77827853         ENDIF 
    77837854         ji=ji+1 
     
    78227893   !> - change way to get information in namelist,  
    78237894   !> value follows string "flt =" 
     7895   !> @date Feb, 2016 
     7896   !> - check character just after keyword 
    78247897   !> 
    78257898   !> @param[in] cd_name      variable name 
     
    78527925         il_ind=INDEX(TRIM(cl_tmp),'flt') 
    78537926         IF( il_ind /= 0 )THEN 
    7854             cl_flt=fct_split(cl_tmp,2,'=') 
    7855             EXIT 
     7927            ! check character just after 
     7928            jj=il_ind+LEN('flt') 
     7929            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     7930            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     7931               cl_flt=fct_split(cl_tmp,2,'=') 
     7932               EXIT 
     7933            ENDIF 
    78567934         ENDIF 
    78577935         ji=ji+1 
     
    79258003   !> @author J.Paul 
    79268004   !> @date June, 2015 - Initial Version 
     8005   !> @date Feb, 2016 
     8006   !> - check character just after keyword 
    79278007   ! 
    79288008   !> @param[in] cd_name      variable name 
     
    79468026      ! loop indices 
    79478027      INTEGER(i4) :: ji 
     8028      INTEGER(i4) :: jj 
    79488029      !---------------------------------------------------------------- 
    79498030 
     
    79558036         il_ind=INDEX(TRIM(cl_tmp),'unt') 
    79568037         IF( il_ind /= 0 )THEN 
    7957             var__get_unt=fct_split(cl_tmp,2,'=') 
    7958             EXIT 
     8038            ! check character just after 
     8039            jj=il_ind+LEN('unt') 
     8040            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 
     8041            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN 
     8042               var__get_unt=fct_split(cl_tmp,2,'=') 
     8043               EXIT 
     8044            ENDIF 
    79598045         ENDIF 
    79608046         ji=ji+1 
     
    81018187 
    81028188            !- change scale factor and offset to avoid mistake 
    8103             tl_att=att_init('scale_factor',1) 
     8189            tl_att=att_init('scale_factor',1._dp) 
    81048190            CALL var_move_att(td_var, tl_att) 
    81058191 
    8106             tl_att=att_init('add_offset',0) 
     8192            tl_att=att_init('add_offset',0._dp) 
    81078193            CALL var_move_att(td_var, tl_att) 
    81088194         ENDIF 
     
    83568442 
    83578443   END FUNCTION var_to_date 
     8444   !------------------------------------------------------------------- 
     8445   !> @brief This subroutine fill dummy variable array 
     8446   ! 
     8447   !> @author J.Paul 
     8448   !> @date September, 2015 - Initial Version 
     8449   ! 
     8450   !> @param[in] cd_dummy dummy configuration file 
     8451   !------------------------------------------------------------------- 
     8452   SUBROUTINE var_get_dummy( cd_dummy ) 
     8453      IMPLICIT NONE 
     8454      ! Argument 
     8455      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy 
     8456 
     8457      ! local variable 
     8458      INTEGER(i4)   :: il_fileid 
     8459      INTEGER(i4)   :: il_status 
     8460 
     8461      LOGICAL       :: ll_exist 
     8462 
     8463      ! loop indices 
     8464      ! namelist 
     8465      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar 
     8466      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim 
     8467      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt 
     8468 
     8469      !---------------------------------------------------------------- 
     8470      NAMELIST /namdum/ &   !< dummy namelist 
     8471      &  cn_dumvar, &       !< variable  name 
     8472      &  cn_dumdim, &       !< dimension name 
     8473      &  cn_dumatt          !< attribute name 
     8474      !---------------------------------------------------------------- 
     8475 
     8476      ! init 
     8477      cm_dumvar(:)='' 
     8478 
     8479      ! read namelist 
     8480      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 
     8481      IF( ll_exist )THEN 
     8482     
     8483         il_fileid=fct_getunit() 
     8484    
     8485         OPEN( il_fileid, FILE=TRIM(cd_dummy), & 
     8486         &                FORM='FORMATTED',       & 
     8487         &                ACCESS='SEQUENTIAL',    & 
     8488         &                STATUS='OLD',           & 
     8489         &                ACTION='READ',          & 
     8490         &                IOSTAT=il_status) 
     8491         CALL fct_err(il_status) 
     8492         IF( il_status /= 0 )THEN 
     8493            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 
     8494         ENDIF 
     8495    
     8496         READ( il_fileid, NML = namdum ) 
     8497         cm_dumvar(:)=cn_dumvar(:) 
     8498 
     8499         CLOSE( il_fileid ) 
     8500 
     8501      ENDIF 
     8502    
     8503   END SUBROUTINE var_get_dummy 
     8504   !------------------------------------------------------------------- 
     8505   !> @brief This function check if variable is defined as dummy variable 
     8506   !> in configuraton file 
     8507   !> 
     8508   !> @author J.Paul 
     8509   !> @date September, 2015 - Initial Version 
     8510   ! 
     8511   !> @param[in] td_var variable structure 
     8512   !> @return true if variable is dummy variable  
     8513   !------------------------------------------------------------------- 
     8514   FUNCTION var_is_dummy(td_var) 
     8515      IMPLICIT NONE 
     8516 
     8517      ! Argument       
     8518      TYPE(TVAR), INTENT(IN) :: td_var 
     8519       
     8520      ! function 
     8521      LOGICAL :: var_is_dummy 
     8522       
     8523      ! loop indices 
     8524      INTEGER(i4) :: ji 
     8525      !---------------------------------------------------------------- 
     8526 
     8527      var_is_dummy=.FALSE. 
     8528      DO ji=1,ip_maxdum 
     8529         IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN 
     8530            var_is_dummy=.TRUE. 
     8531            EXIT 
     8532         ENDIF 
     8533      ENDDO 
     8534 
     8535   END FUNCTION var_is_dummy 
    83588536END MODULE var 
    83598537 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/vgrid.f90

    r5616 r6392  
    291291   END SUBROUTINE vgrid_zgr_z 
    292292   !------------------------------------------------------------------- 
     293   !> @brief This subroutine 
     294   !> 
     295   !> @todo add subroutine description 
     296   !> 
     297   !> @param[inout] dd_bathy 
     298   !> @param[in] dd_gdepw 
     299   !> @param[in] dd_hmin 
     300   !> @param[in] dd_fill 
    293301   !------------------------------------------------------------------- 
    294302   SUBROUTINE vgrid_zgr_bat( dd_bathy, dd_gdepw, dd_hmin, dd_fill ) 
     
    371379   !>         - gdept, gdepw and e3 are positives 
    372380   !>         - gdept_ps, gdepw_ps and e3_ps are positives 
    373    ! 
     381   !> 
    374382   !> @author A. Bozec, G. Madec 
    375383   !> @date February, 2009 - F90: Free form and module 
     
    386394   !> @param[in] dd_e3zps_min 
    387395   !> @param[in] dd_e3zps_rat 
     396   !> @param[in] dd_fill 
    388397   !------------------------------------------------------------------- 
    389398   SUBROUTINE vgrid_zgr_zps( id_mbathy, dd_bathy, id_jpkmax, & 
     
    495504   !> ** Action  : - update mbathy: level bathymetry (in level index) 
    496505   !>              - update bathy : meter bathymetry (in meters) 
    497  
     506   !> 
    498507   !> @author G.Madec 
    499508   !> @date Marsh, 2008 - Original code 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam

    r5608 r6392  
    11&namlog 
    2    cn_logfile="bathy_out.log" 
     2   cn_logfile= 
    33   cn_verbosity= 
    44   in_maxerror= 
     
    66 
    77&namcfg 
    8    cn_varcfg="./cfg/variable.cfg" 
     8   cn_varcfg= 
     9   cn_dumcfg= 
    910/ 
    1011 
     
    1617&namfin 
    1718   cn_coord1= 
     19   in_perio1= 
     20   ln_fillclosed= 
    1821/ 
    1922 
     
    2932 
    3033&namout 
    31    cn_fileout="bathy_out.nc"       
     34   cn_fileout= 
    3235/ 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam

    r5608 r6392  
    11&namlog 
    2    cn_logfile="boundary.log" 
     2   cn_logfile= 
    33   cn_verbosity= 
    44   in_maxerror = 
     
    66 
    77&namcfg 
    8    cn_varcfg="./cfg/variable.cfg" 
     8   cn_varcfg= 
     9   cn_dumcfg= 
    910/ 
    1011 
     
    4142 
    4243&namvar 
     44   cn_varfile= 
    4345   cn_varinfo= 
    44    cn_varfile= 
    4546/ 
    4647 
     
    6364 
    6465&namout 
    65    cn_fileout="boundary_out.nc"       
     66   cn_fileout= 
    6667   dn_dayofs= 
    6768   ln_extrap= 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/templates/create_coord.nam

    r5037 r6392  
    11&namlog 
    2    cn_logfile="coord_out.log" 
     2   cn_logfile= 
    33   cn_verbosity= 
    44   in_maxerror= 
     
    66 
    77&namcfg 
    8    cn_varcfg="./cfg/variable.cfg" 
     8   cn_varcfg= 
     9   cn_dumcfg= 
    910/ 
    1011 
     
    2930 
    3031&namout 
    31    cn_fileout="coord_out.nc" 
     32   cn_fileout= 
    3233/ 
    3334 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam

    r5608 r6392  
    11&namlog 
    2    cn_logfile="restart_out.log" 
     2   cn_logfile= 
    33   cn_verbosity= 
    4    in_maxerror = 
     4   in_maxerror= 
    55/ 
    66 
    77&namcfg 
    8    cn_varcfg="./cfg/variable.cfg" 
     8   cn_varcfg= 
     9   cn_dumcfg= 
    910/ 
    1011 
     
    4142 
    4243&namvar 
     44   cn_varfile= 
    4345   cn_varinfo= 
    44    cn_varfile= 
    4546/ 
    4647 
     
    5152 
    5253&namout 
    53    cn_fileout="restart_out.nc"       
     54   cn_fileout= 
    5455   ln_extrap= 
    55    in_nipro= 
     56   in_niproc= 
    5657   in_njproc= 
    5758   in_nproc= 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/templates/merge_bathy.nam

    r5037 r6392  
    11&namlog 
    2    cn_logfile="merge_out.log" 
     2   cn_logfile= 
    33   cn_verbosity= 
    4    in_maxerror = 
     4   in_maxerror= 
    55/ 
    66 
    77&namcfg 
    8    cn_varcfg="./cfg/variable.cfg" 
     8   cn_varcfg= 
     9   cn_dumcfg= 
    910/ 
    1011 
     
    1718   cn_bathy1= 
    1819   in_perio1= 
    19 / 
    20  
    21 &namvar 
    22    cn_varinfo= 
    2320/ 
    2421 
     
    4138 
    4239&namout 
    43    cn_fileout="merge_out.nc"       
     40   cn_fileout= 
    4441/ 
Note: See TracChangeset for help on using the changeset viewer.