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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90

    r4213 r6225  
    66! 
    77! DESCRIPTION: 
    8 !> @brief massively parallel processing Input/Output manager :   
    9 !> Library to read/write mpp files<br/> 
     8!> @brief This module manage massively parallel processing Input/Output manager. 
     9!> Library to read/write mpp files. 
    1010!> 
    1111!> @details 
    12 !>  
    1312!>    to open mpp files (only file to be used (see mpp_get_use)  
    1413!>    will be open):<br/> 
     14!> @code 
    1515!>    CALL iom_mpp_open(td_mpp) 
     16!> @endcode 
    1617!>       - td_mpp is a mpp structure 
    1718!> 
    1819!>    to creates mpp files:<br/> 
     20!> @code 
    1921!>    CALL iom_mpp_create(td_mpp) 
     22!> @endcode 
    2023!>       - td_mpp is a mpp structure 
    2124!> 
    2225!>    to write in mpp files :<br/> 
     26!> @code 
    2327!>    CALL  iom_mpp_write_file(td_mpp) 
     28!> @endcode 
    2429!>       - td_mpp is a mpp structure 
    2530!> 
    2631!>    to close mpp files:<br/> 
     32!> @code 
    2733!>    CALL iom_mpp_close(td_mpp) 
     34!> @endcode 
    2835!> 
    2936!>    to read one variable in an mpp files:<br/> 
    30 !>    - tl_var=iom_mpp_read_var( td_mpp, id_varid, [td_dom,] [ld_border] )  
    31 !>    - tl_var=iom_mpp_read_var( td_mpp, [cd_name,] [td_dom,] [ld_border,] [cd_stdname] )  
     37!> @code 
     38!>    tl_var=iom_mpp_read_var( td_mpp, id_varid, [id_start, id_count] [,id_ew] )  
     39!> @endcode 
     40!>    or 
     41!> @code 
     42!>    tl_var=iom_mpp_read_var( td_mpp, cd_name, [id_start, id_count] [,id_ew] )  
     43!> @endcode 
    3244!>       - td_mpp is a mpp structure 
    3345!>       - id_varid is a variable id 
    34 !>       - td_dom is a domain structure (optional, can't be used with ld_border) 
    35 !>       - ld_border is true if we want to read border of global domain only 
    36 !>       (optional, can't be used with td_dom) 
    37 !>       - cd_name is variable name (optional, cd_name and/or cd_stdname should be specify.) 
    38 !>       - cd_stdname is variable standard name (optional, cd_name and/or cd_stdname should be specify.) 
    39 !> 
     46!>       - cd_name is variable name or standard name 
     47!>       - id_start is a integer(4) 1D array of index from which the data  
     48!>          values will be read [optional] 
     49!>       - id_count is a integer(4) 1D array of the number of indices selected 
     50!>          along each dimension [optional] 
     51!>       - id_ew East West overlap [optional] 
     52!> 
     53!>    to fill variable value in mpp structure:<br/> 
     54!> @code 
     55!>    CALL iom_mpp_fill_var(td_mpp, id_varid, [id_start, id_count] [,id_ew] ) 
     56!> @endcode 
     57!>    or<br/> 
     58!> @code 
     59!>    CALL iom_mpp_fill_var(td_mpp, cd_name, [id_start, id_count] [,id_ew] ) 
     60!> @endcode 
     61!>       - td_mpp is mpp structure 
     62!>       - id_varid is variable id 
     63!>       - cd_name is variable name or standard name 
     64!>       - id_start is a integer(4) 1D array of index from which the data  
     65!>          values will be read [optional] 
     66!>       - id_count is a integer(4) 1D array of the number of indices selected 
     67!>          along each dimension [optional] 
     68!>       - id_ew East West overlap [optional] 
     69!> 
     70!>    to fill all variable in mpp structure:<br/> 
     71!> @code 
     72!>    CALL iom_mpp_fill_var(td_mpp, [id_start, id_count] [,id_ew] ) 
     73!> @endcode 
     74!>       - td_mpp is mpp structure 
     75!>       - id_start is a integer(4) 1D array of index from which the data  
     76!>          values will be read [optional] 
     77!>       - id_count is a integer(4) 1D array of the number of indices selected 
     78!>          along each dimension [optional] 
     79!>       - id_ew East West overlap 
     80!> 
     81!>    to write files composong mpp strucutre:<br/> 
     82!> @code 
     83!>    CALL iom_mpp_write_file(td_mpp)  
     84!> @endcode 
    4085!> 
    4186!> @author 
    4287!> J.Paul 
    4388! REVISION HISTORY: 
    44 !> @date Nov, 2013 - Initial Version 
    45 ! 
     89!> @date November, 2013 - Initial Version 
     90!> 
    4691!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    47 !> @todo 
    48 !> - add read var with start and count as in iom 
    49 !> - add iom_mpp_fill_var_value : cf iom_fill_var_value  
    50 !> - not so easy to use that it should be, have to work on it 
    51 !> - improve mpp init 
    52 !> - improve mpp_get_use 
    53 !> - imporve dom_init 
    5492!---------------------------------------------------------------------- 
    5593MODULE iom_mpp 
    5694   USE netcdf                          ! nf90 library 
     95   USE global                          ! global parameter 
    5796   USE kind                            ! F90 kind parameter 
    5897   USE fct                             ! basic useful function 
    59    USE logger                             ! log file manager 
     98   USE logger                          ! log file manager 
    6099   USE dim                             ! dimension manager 
    61100   USE att                             ! attribute manager 
    … …  
    64103   USE iom                             ! I/O manager 
    65104   USE mpp                             ! mpp manager 
    66    USE dom                             ! domain manager 
    67105   IMPLICIT NONE 
    68    PRIVATE 
    69106   ! NOTE_avoid_public_variables_if_possible 
    70107 
    71108   ! function and subroutine 
    72    PUBLIC :: iom_mpp_open                    !< open files composing mpp structure to be used 
    73    PUBLIC :: iom_mpp_create                  !< creates files composing mpp structure to be used 
     109   PUBLIC :: iom_mpp_open                    !< open all files composing mpp structure 
     110   PUBLIC :: iom_mpp_create                  !< creates files composing mpp structure 
    74111   PUBLIC :: iom_mpp_close                   !< close file composing mpp structure 
    75112   PUBLIC :: iom_mpp_read_var                !< read one variable in an mpp structure 
    76    PUBLIC :: iom_mpp_fill_var                !< fill variable value in mpp structure 
    77113   PUBLIC :: iom_mpp_write_file              !< write mpp structure in files 
    78114 
    79    PRIVATE :: iom_mpp__read_var_id           !< read one variable in an mpp structure, given variable id 
    80    PRIVATE :: iom_mpp__read_var_name         !< read one variable in an mpp structure, given variable name 
    81    PRIVATE :: iom_mpp__read_var_value        !< read variable value in an mpp structure 
    82    PRIVATE :: iom_mpp__no_pole_no_overlap    !< do not overlap north fold boundary or east-west boundary 
    83    PRIVATE :: iom_mpp__no_pole_cyclic        !< do not overlap north fold boundary. However uses cyclic east-west boundary 
    84    PRIVATE :: iom_mpp__no_pole_overlap       !< do not overlap north fold boundary. However overlaps east-west boundary 
    85 !   PRIVATE :: iom_mpp__pole_no_overlap       !< overlaps north fold boundary. However do not overlap east-west boundary 
    86 !   PRIVATE :: iom_mpp__pole_cyclic           !< overlaps north fold boundary and uses cyclic east-west boundary 
    87 !   PRIVATE :: iom_mpp__pole_overlap          !< overlaps north fold boundary and east-west boundary 
    88  
    89    INTERFACE iom_mpp_read_var                   !< read one variable in an mpp structure 
    90       MODULE PROCEDURE iom_mpp__read_var_id     !< given variable id 
    91       MODULE PROCEDURE iom_mpp__read_var_name   !< given variable name  
     115   PRIVATE :: iom_mpp__read_var_id           ! read one variable in an mpp structure, given variable id 
     116   PRIVATE :: iom_mpp__read_var_name         ! read one variable in an mpp structure, given variable name 
     117   PRIVATE :: iom_mpp__read_var_value        ! read variable value in an mpp structure 
     118 
     119   INTERFACE iom_mpp_read_var                   ! read one variable in an mpp structure 
     120      MODULE PROCEDURE iom_mpp__read_var_id     ! given variable id 
     121      MODULE PROCEDURE iom_mpp__read_var_name   ! given variable name  
    92122   END INTERFACE iom_mpp_read_var 
    93123 
    94    INTERFACE iom_mpp_fill_var                !< fill variable value in an mpp structure 
    95       MODULE PROCEDURE iom_mpp__fill_var_id   !< given variable id 
    96       MODULE PROCEDURE iom_mpp__fill_var_name !< given variable name 
    97       MODULE PROCEDURE iom_mpp__fill_var_all  !< fill all variable 
    98    END INTERFACE iom_mpp_fill_var 
    99  
    100124CONTAINS 
    101125   !------------------------------------------------------------------- 
    102    !> @brief This subroutine open files composing mpp structure to be used<br/> 
     126   !> @brief This subroutine open files composing mpp structure to be used. 
     127   !> @details 
    103128   !> If try to open a file in write mode that did not exist, create it.<br/> 
    104129   !>  
    … …  
    112137   !> 
    113138   !> @author J.Paul 
    114    !> - Nov, 2013- Initial Version 
    115    ! 
    116    !> @param[inout] td_mpp : mpp structure 
    117    !------------------------------------------------------------------- 
    118    !> @code 
    119    SUBROUTINE iom_mpp_open(td_mpp) 
     139   !> @date November, 2013 - Initial Version 
     140   ! 
     141   !> @param[inout] td_mpp mpp structure 
     142   !------------------------------------------------------------------- 
     143   SUBROUTINE iom_mpp_open(td_mpp, id_perio, id_ew) 
    120144      IMPLICIT NONE 
    121145      ! Argument       
    122       TYPE(TMPP), INTENT(INOUT)  :: td_mpp 
     146      TYPE(TMPP) , INTENT(INOUT)  :: td_mpp 
     147      INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio 
     148      INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew 
    123149 
    124150      ! local variable 
    … …  
    135161 
    136162      ELSE 
    137          IF( ANY(td_mpp%t_proc(:)%l_use) )THEN 
    138  
    139             ! add suffix to mpp name 
    140             td_mpp%c_name=file_add_suffix( TRIM(td_mpp%c_name), & 
    141                                          & TRIM(td_mpp%c_type) ) 
    142  
    143             td_mpp%t_proc(:)%c_type=TRIM(td_mpp%c_type)  
    144             IF( td_mpp%i_nproc > 1 )THEN 
    145                DO ji=1,td_mpp%i_nproc 
    146                   IF( td_mpp%t_proc(ji)%l_use )THEN 
    147  
     163         !  
     164         td_mpp%i_id=1 
     165 
     166         ! if no processor file selected 
     167         ! force to open all files  
     168         IF( .NOT. ANY( td_mpp%t_proc(:)%l_use ) )THEN 
     169            td_mpp%t_proc(:)%l_use=.TRUE. 
     170         ENDIF 
     171 
     172         ! add suffix to mpp name 
     173         td_mpp%c_name=file_add_suffix( TRIM(td_mpp%c_name), & 
     174                                      & TRIM(td_mpp%c_type) ) 
     175 
     176         td_mpp%t_proc(:)%c_type=TRIM(td_mpp%c_type)  
     177         IF( td_mpp%i_nproc > 1 )THEN 
     178            DO ji=1,td_mpp%i_nproc 
     179               IF( td_mpp%t_proc(ji)%l_use )THEN 
     180 
     181                  SELECT CASE(TRIM(td_mpp%c_type)) 
     182                  CASE('cdf') 
     183                     cl_name=TRIM( file_rename(td_mpp%c_name, ji-1) ) 
     184                  CASE('dimg') 
    148185                     cl_name=TRIM( file_rename(td_mpp%c_name, ji) ) 
    149                      td_mpp%t_proc(ji)%c_name=TRIM(cl_name) 
    150  
    151                      CALL iom_open(td_mpp%t_proc(ji)) 
    152  
    153                   ENDIF 
    154                ENDDO 
    155             ELSE ! td_mpp%i_nproc == 1  
    156                   cl_name=TRIM( file_rename(td_mpp%c_name) ) 
    157                   td_mpp%t_proc(1)%c_name=TRIM(cl_name) 
    158  
    159                   CALL iom_open(td_mpp%t_proc(1)) 
    160             ENDIF 
    161  
    162          ELSE 
    163  
    164             IF( ANY(td_mpp%t_proc(:)%l_ctr) )THEN 
    165  
    166                CALL logger_warn("IOM MPP OPEN: open file on border") 
    167                DO ji=1,td_mpp%i_nproc 
    168                   IF( td_mpp%t_proc(ji)%l_ctr )THEN 
    169                      CALL iom_open(td_mpp%t_proc(ji)) 
    170                   ENDIF 
    171                ENDDO 
    172  
    173             ELSE 
    174                CALL logger_error( " IOM MPP OPEN: no processor to be used.") 
    175                CALL logger_debug( " use mpp_get_use before running iom_mpp_open") 
    176             ENDIF 
    177          ENDIF 
     186                  CASE DEFAULT 
     187                     CALL logger_fatal("IOM MPP OPEN: can not open file "//& 
     188                     &  "of type "//TRIM(td_mpp%c_type)) 
     189                  END SELECT 
     190 
     191                  td_mpp%t_proc(ji)%c_name=TRIM(cl_name) 
     192 
     193                  CALL iom_open(td_mpp%t_proc(ji)) 
     194 
     195               ENDIF 
     196            ENDDO 
     197         ELSE ! td_mpp%i_nproc == 1  
     198               cl_name=TRIM( file_rename(td_mpp%c_name) ) 
     199               td_mpp%t_proc(1)%c_name=TRIM(cl_name) 
     200 
     201               CALL iom_open(td_mpp%t_proc(1)) 
     202         ENDIF 
     203 
     204         IF( PRESENT(id_ew) )THEN 
     205            td_mpp%i_ew=id_ew 
     206            ! add east west overlap to each variable 
     207            DO ji=1,td_mpp%i_nproc 
     208               WHERE(td_mpp%t_proc(ji)%t_var(:)%t_dim(1)%l_use) 
     209                  td_mpp%t_proc(ji)%t_var(:)%i_ew=td_mpp%i_ew 
     210               ENDWHERE 
     211            ENDDO 
     212         ENDIF 
     213 
     214         IF( PRESENT(id_perio) )THEN 
     215            td_mpp%i_perio=id_perio 
     216         ENDIF 
     217 
    178218      ENDIF 
    179219 
    180220   END SUBROUTINE iom_mpp_open 
    181    !> @endcode 
    182221   !------------------------------------------------------------------- 
    183222   !> @brief This subroutine create files, composing mpp structure to be used, 
    184    !> in write mode<br/> 
     223   !> in write mode. 
    185224   !>  
    186225   !> @author J.Paul 
    187    !> - Nov, 2013- Initial Version 
    188    ! 
    189    !> @param[inout] td_mpp : mpp structure 
    190    !------------------------------------------------------------------- 
    191    !> @code 
     226   !> @date November, 2013 - Initial Version 
     227   ! 
     228   !> @param[inout] td_mpp mpp structure 
     229   !------------------------------------------------------------------- 
    192230   SUBROUTINE iom_mpp_create(td_mpp) 
    193231      IMPLICIT NONE 
    … …  
    209247 
    210248   END SUBROUTINE iom_mpp_create 
    211    !> @endcode 
    212249   !------------------------------------------------------------------- 
    213250   !> @brief This subroutine close files composing mpp structure. 
    214251   !> 
    215252   !> @author J.Paul 
    216    !> - Nov, 2013- Initial Version 
    217    ! 
    218    !> @param[in] td_mpp : mpp structure 
    219    !------------------------------------------------------------------- 
    220    !> @code 
     253   !> @date November, 2013 - Initial Version 
     254   ! 
     255   !> @param[in] td_mpp mpp structure 
     256   !------------------------------------------------------------------- 
    221257   SUBROUTINE iom_mpp_close(td_mpp) 
    222258      IMPLICIT NONE 
    … …  
    234270 
    235271      ELSE 
     272         !  
     273         td_mpp%i_id=0          
     274 
    236275         DO ji=1,td_mpp%i_nproc 
    237276            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
    … …  
    239278            ENDIF 
    240279         ENDDO 
     280         td_mpp%t_proc(:)%l_use=.FALSE. 
    241281      ENDIF 
    242282 
    243283   END SUBROUTINE iom_mpp_close 
    244    !> @endcode 
    245284   !------------------------------------------------------------------- 
    246285   !> @brief This function read variable value in opened mpp files, 
    247    !> given variable id.</br/> 
     286   !> given variable id. 
    248287   !> 
    249288   !> @details 
    250    !> If domain is given, read only domain. 
    251    !> If border is .TRUE., read only border processor    
    252    !> 
    253    ! 
     289   !> Optionally start indices and number of point to be read could be specify. 
     290   !> as well as East West ovelap of the global domain. 
     291   !> 
    254292   !> @author J.Paul 
    255    !> - Nov, 2013- Initial Version 
    256    ! 
    257    !> @param[in] td_mpp : mpp structure 
    258    !> @param[in] id_varid : variable id 
    259    !> @param[in] td_dom : domain structure 
    260    !> @param[in] ld_border : read only border 
     293   !> @date November, 2013 - Initial Version 
     294   !> @date October, 2014 
     295   !> - use start and count array instead of domain structure. 
     296   !> 
     297   !> @param[in] td_mpp    mpp structure 
     298   !> @param[in] id_varid  variable id 
     299   !> @param[in] id_start  index in the variable from which the data values  
     300   !> will be read 
     301   !> @param[in] id_count  number of indices selected along each dimension 
    261302   !> @return  variable structure  
    262303   !------------------------------------------------------------------- 
    263    !> @code 
    264304   TYPE(TVAR) FUNCTION iom_mpp__read_var_id(td_mpp, id_varid,& 
    265    &                                        td_dom, ld_border) 
     305   &                                        id_start, id_count) 
    266306      IMPLICIT NONE 
    267307      ! Argument       
    268       TYPE(TMPP),    INTENT(IN) :: td_mpp 
    269       INTEGER(i4),   INTENT(IN) :: id_varid 
    270       TYPE(TDOM) ,   INTENT(IN), OPTIONAL :: td_dom 
    271       LOGICAL,       INTENT(IN), OPTIONAL :: ld_border 
     308      TYPE(TMPP),                INTENT(IN) :: td_mpp 
     309      INTEGER(i4),               INTENT(IN) :: id_varid 
     310      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start 
     311      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count       
    272312 
    273313      ! local variable 
    … …  
    280320         &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    281321 
     322      ELSEIF( td_mpp%i_id == 0 )THEN 
     323 
     324         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//& 
     325         &               " can not read variable in "//TRIM(td_mpp%c_name))    
     326       
    282327      ELSE 
     328 
    283329 
    284330         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN 
    … …  
    288334            IF( il_ind(1) /= 0 )THEN 
    289335 
    290                iom_mpp__read_var_id=td_mpp%t_proc(1)%t_var(il_ind(1)) 
     336               iom_mpp__read_var_id=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1))) 
    291337 
    292338               !!! read variable value 
    293339               CALL iom_mpp__read_var_value(td_mpp, iom_mpp__read_var_id, & 
    294                &                            td_dom, ld_border) 
     340               &                            id_start, id_count) 
    295341 
    296342            ELSE 
    … …  
    308354 
    309355   END FUNCTION iom_mpp__read_var_id 
    310    !> @endcode 
    311356   !------------------------------------------------------------------- 
    312357   !> @brief This function read variable value in opened mpp files,  
    313    !> given variable name or standard name.</br/> 
     358   !> given variable name or standard name. 
     359   !> 
    314360   !> @details 
    315    !> If domain is given, read only domain. 
    316    !> If border is .TRUE., read only border processor 
    317    ! 
    318    !> @details 
     361   !> Optionally start indices and number of point to be read could be specify. 
     362   !> as well as East West ovelap of the global domain. 
     363   !> 
    319364   !> look first for variable name. If it doesn't 
    320365   !> exist in file, look for variable standard name.<br/> 
    … …  
    322367   ! 
    323368   !> @author J.Paul 
    324    !> - Nov, 2013- Initial Version 
    325    ! 
    326    !> @param[in] td_mpp : mpp structure 
    327    !> @param[in] cd_name : variable name 
    328    !> @param[in] td_dom : domain structure 
    329    !> @param[in] ld_border : read only border  
     369   !> @date November, 2013 - Initial Version 
     370   !> @date October, 2014 
     371   !> - use start and count array instead of domain structure. 
     372   ! 
     373   !> @param[in] td_mpp    mpp structure 
     374   !> @param[in] cd_name   variable name 
     375   !> @param[in] id_start  index in the variable from which the data values  
     376   !> will be read 
     377   !> @param[in] id_count  number of indices selected along each dimension 
    330378   !> @return  variable structure  
    331379   !------------------------------------------------------------------- 
    332    !> @code 
    333380   TYPE(TVAR) FUNCTION iom_mpp__read_var_name(td_mpp, cd_name,    & 
    334    &                                          td_dom, ld_border  ) 
     381   &                                          id_start, id_count ) 
    335382      IMPLICIT NONE 
    336383      ! Argument       
    337       TYPE(TMPP),       INTENT(IN) :: td_mpp 
    338       CHARACTER(LEN=*), INTENT(IN) :: cd_name 
    339       TYPE(TDOM) ,      INTENT(IN), OPTIONAL :: td_dom 
    340       LOGICAL,          INTENT(IN), OPTIONAL :: ld_border 
    341  
    342       ! local variable 
    343       INTEGER(i4)       :: il_varid 
    344       !---------------------------------------------------------------- 
    345       ! check if mpp exist 
    346       IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 
    347  
    348          CALL logger_error( " IOM MPP READ VAR: domain decomposition not define "//& 
    349          &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    350  
    351       ELSE 
    352  
    353             il_varid=var_get_id( td_mpp%t_proc(1)%t_var(:), cd_name) 
    354             IF( il_varid /= 0 )THEN 
    355  
    356                iom_mpp__read_var_name=td_mpp%t_proc(1)%t_var(il_varid) 
    357  
    358                !!! read variable value 
    359                CALL iom_mpp__read_var_value( td_mpp, & 
    360                &                             iom_mpp__read_var_name, & 
    361                &                             td_dom, ld_border) 
    362  
    363             ELSE 
    364  
    365                CALL logger_error( & 
    366                &  " IOM MPP READ VAR: there is no variable with "//& 
    367                &  "name or standard name"//TRIM(cd_name)//& 
    368                &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name)) 
    369             ENDIF 
    370  
    371       ENDIF 
    372        
    373    END FUNCTION iom_mpp__read_var_name 
    374    !> @endcode 
    375    !------------------------------------------------------------------- 
    376    !> @brief This subroutine fill all variable value in opened mpp files, 
    377    !> given variable id.</br/> 
    378    !> 
    379    !> @details 
    380    !> If domain is given, read only domain. 
    381    !> If border is .TRUE., read only border processor    
    382    !>  
    383    ! 
    384    !> @author J.Paul 
    385    !> - Nov, 2013- Initial Version 
    386    ! 
    387    !> @param[inout] td_mpp : mpp structure 
    388    !> @param[in] td_dom : domain structure 
    389    !> @param[in] ld_border : read only border 
    390    !------------------------------------------------------------------- 
    391    !> @code 
    392    SUBROUTINE iom_mpp__fill_var_all(td_mpp, td_dom, ld_border) 
    393       IMPLICIT NONE 
    394       ! Argument       
    395       TYPE(TMPP),    INTENT(INOUT) :: td_mpp 
    396       TYPE(TDOM) ,   INTENT(IN),   OPTIONAL :: td_dom 
    397       LOGICAL,       INTENT(IN),   OPTIONAL :: ld_border 
    398  
    399       ! local variable 
    400  
    401       ! loop indices 
    402       INTEGER(i4) :: ji 
    403       !---------------------------------------------------------------- 
    404       ! check if mpp exist 
    405       IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 
    406  
    407          CALL logger_error( " IOM MPP FILL VAR : domain decomposition not define "//& 
    408          &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    409  
    410       ELSE 
    411  
    412          DO ji=1,td_mpp%t_proc(1)%i_nvar 
    413             CALL iom_mpp_fill_var(td_mpp, ji, td_dom, ld_border ) 
    414          ENDDO 
    415  
    416       ENDIF 
    417  
    418    END SUBROUTINE iom_mpp__fill_var_all 
    419    !> @endcode 
    420    !------------------------------------------------------------------- 
    421    !> @brief This subroutine fill variable value in opened mpp files, 
    422    !> given variable id.</br/> 
    423    !> 
    424    !> @details 
    425    !> If domain is given, read only domain. 
    426    !> If border is .TRUE., read only border processor    
    427    !>  
    428    ! 
    429    !> @author J.Paul 
    430    !> - Nov, 2013- Initial Version 
    431    ! 
    432    !> @param[inout] td_mpp : mpp structure 
    433    !> @param[in] id_varid : variable id 
    434    !> @param[in] td_dom : domain structure 
    435    !> @param[in] ld_border : read only border 
    436    !------------------------------------------------------------------- 
    437    !> @code 
    438    SUBROUTINE iom_mpp__fill_var_id(td_mpp, id_varid, td_dom, ld_border) 
    439       IMPLICIT NONE 
    440       ! Argument       
    441       TYPE(TMPP),    INTENT(INOUT) :: td_mpp 
    442       INTEGER(i4),   INTENT(IN)    :: id_varid 
    443       TYPE(TDOM) ,   INTENT(IN),   OPTIONAL :: td_dom 
    444       LOGICAL,       INTENT(IN),   OPTIONAL :: ld_border 
    445  
    446       ! local variable 
    447       INTEGER(i4), DIMENSION(1) :: il_ind 
    448       !---------------------------------------------------------------- 
    449       ! check if mpp exist 
    450       IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 
    451  
    452          CALL logger_error( " IOM MPP FILL VAR: domain decomposition not define "//& 
    453          &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    454  
    455       ELSE 
    456  
    457          IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN 
    458             ! look for variable id 
    459             il_ind(:)=MINLOC( td_mpp%t_proc(1)%t_var(:)%i_id, & 
    460             &           mask=(td_mpp%t_proc(1)%t_var(:)%i_id==id_varid)) 
    461             IF( il_ind(1) /= 0 )THEN 
    462  
    463                !!! read variable value 
    464                CALL iom_mpp__read_var_value( td_mpp, & 
    465                &                     td_mpp%t_proc(1)%t_var(il_ind(1)), & 
    466                &                     td_dom, ld_border) 
    467  
    468             ELSE 
    469                CALL logger_error( & 
    470                &  " IOM MPP FILL VAR : there is no variable with id "//& 
    471                &  TRIM(fct_str(id_varid))//" in processor/file "//& 
    472                &  TRIM(td_mpp%t_proc(1)%c_name)) 
    473             ENDIF 
    474          ELSE 
    475             CALL logger_error(" IOM MPP FILL VAR : can't read variable, mpp "//& 
    476             &  TRIM(td_mpp%c_name)//" not opened") 
    477          ENDIF 
    478  
    479       ENDIF 
    480  
    481    END SUBROUTINE iom_mpp__fill_var_id 
    482    !> @endcode 
    483    !------------------------------------------------------------------- 
    484    !> @brief This subroutine fill variable value in opened mpp files,  
    485    !> given variable name or standard name.</br/> 
    486    !> @details 
    487    !> If domain is given, read only domain. 
    488    !> If border is .TRUE., read only border processor    
    489    ! 
    490    !> @details 
    491    !> look first for variable name. If it doesn't 
    492    !> exist in file, look for variable standard name.<br/> 
    493    !> If variable name is not present, check variable standard name.<br/> 
    494    ! 
    495    !> @author J.Paul 
    496    !> - Nov, 2013- Initial Version 
    497    ! 
    498    !> @param[inout] td_mpp : mpp structure 
    499    !> @param[in] cd_name : variable name or standard name 
    500    !> @param[in] td_dom : domain structure 
    501    !> @param[in] ld_border : read only border  
    502    !------------------------------------------------------------------- 
    503    !> @code 
    504    SUBROUTINE iom_mpp__fill_var_name(td_mpp, cd_name, td_dom, ld_border ) 
    505       IMPLICIT NONE 
    506       ! Argument       
    507       TYPE(TMPP),       INTENT(INOUT) :: td_mpp 
    508       CHARACTER(LEN=*), INTENT(IN   ) :: cd_name 
    509       TYPE(TDOM) ,      INTENT(IN   ), OPTIONAL :: td_dom 
    510       LOGICAL,          INTENT(IN   ), OPTIONAL :: ld_border 
     384      TYPE(TMPP),                INTENT(IN) :: td_mpp 
     385      CHARACTER(LEN=*),          INTENT(IN) :: cd_name 
     386      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start 
     387      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count       
    511388 
    512389      ! local variable 
    … …  
    516393      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 
    517394 
    518          CALL logger_error( " IOM MPP FILL VAR : domain decomposition not define "//& 
     395         CALL logger_error( " IOM MPP READ VAR: domain decomposition not define "//& 
    519396         &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    520397 
     398      ELSEIF( td_mpp%i_id == 0 )THEN 
     399 
     400         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//& 
     401         &               " can not read variable in "//TRIM(td_mpp%c_name))    
     402       
    521403      ELSE 
    522404 
    523             il_ind=var_get_id( td_mpp%t_proc(1)%t_var(:), cd_name, cd_name) 
     405            il_ind=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name) 
    524406            IF( il_ind /= 0 )THEN 
    525407 
     408               iom_mpp__read_var_name=var_copy(td_mpp%t_proc(1)%t_var(il_ind)) 
     409 
    526410               !!! read variable value 
    527                CALL iom_mpp__read_var_value(td_mpp, & 
    528                &                    td_mpp%t_proc(1)%t_var(il_ind), & 
    529                &                    td_dom, ld_border) 
     411               CALL iom_mpp__read_var_value( td_mpp, & 
     412               &                             iom_mpp__read_var_name, & 
     413               &                             id_start, id_count) 
    530414 
    531415            ELSE 
    532416 
    533417               CALL logger_error( & 
    534                &  " IOM MPP FILL VAR : there is no variable with "//& 
     418               &  " IOM MPP READ VAR: there is no variable with "//& 
    535419               &  "name or standard name "//TRIM(cd_name)//& 
    536420               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name)) 
    537  
    538421            ENDIF 
    539422 
    540423      ENDIF 
    541424       
    542    END SUBROUTINE iom_mpp__fill_var_name 
    543    !> @endcode 
     425   END FUNCTION iom_mpp__read_var_name 
    544426   !------------------------------------------------------------------- 
    545427   !> @brief This subroutine read variable value 
    … …  
    547429   !> 
    548430   !> @details 
    549    !> If domain is given, read only domain. 
    550    !> If border is .TRUE., read only border processor 
     431   !> Optionally start indices and number of point to be read could be specify. 
     432   !> as well as East West ovelap of the global domain. 
    551433   ! 
    552434   !> @author J.Paul 
    553    !> - Nov, 2013- Initial Version 
    554    ! 
    555    !> @param[in] td_mpp    : mpp structure 
    556    !> @param[inout] td_var : variable structure 
    557    !> @param[in] td_dom    : domain structure 
    558    !> @param[in] ld_border : read only border 
    559    !> @return variable structure completed  
    560    ! 
    561    !> @todo 
    562    !> - modif en fonction dimension de la variable lu pour cas dom 
    563    !------------------------------------------------------------------- 
    564    !> @code 
     435   !> @date November, 2013 - Initial Version 
     436   !> @date October, 2014 
     437   !> - use start and count array instead of domain structure. 
     438   !> 
     439   !> @param[in] td_mpp    mpp structure 
     440   !> @param[inout] td_var variable structure 
     441   !> @param[in] id_start  index in the variable from which the data values  
     442   !> will be read 
     443   !> @param[in] id_count  number of indices selected along each dimension 
     444   !------------------------------------------------------------------- 
    565445   SUBROUTINE iom_mpp__read_var_value(td_mpp, td_var, & 
    566    &                                  td_dom, ld_border ) 
     446   &                                  id_start, id_count ) 
    567447      IMPLICIT NONE 
    568448      ! Argument       
    569449      TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    570450      TYPE(TVAR),   INTENT(INOUT) :: td_var 
    571       TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom 
    572       LOGICAL,      INTENT(IN),   OPTIONAL :: ld_border 
     451      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_start 
     452      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_count       
    573453 
    574454      ! local variable 
    … …  
    579459      INTEGER(i4)                       :: il_j1p 
    580460      INTEGER(i4)                       :: il_j2p 
    581  
    582       LOGICAL                           :: ll_border 
     461      INTEGER(i4)                       :: il_i1 
     462      INTEGER(i4)                       :: il_i2 
     463      INTEGER(i4)                       :: il_j1 
     464      INTEGER(i4)                       :: il_j2 
     465 
     466      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 
     467      INTEGER(i4), DIMENSION(ip_maxdim) :: il_end 
     468      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count       
     469 
     470      INTEGER(i4), DIMENSION(ip_maxdim) :: il_strt 
     471      INTEGER(i4), DIMENSION(ip_maxdim) :: il_cnt       
     472 
     473      TYPE(TATT)                        :: tl_att 
    583474      TYPE(TVAR)                        :: tl_var 
    584       TYPE(TMPP)                        :: tl_mpp 
    585       TYPE(TDOM)                        :: tl_dom 
    586475 
    587476      ! loop indices 
    … …  
    589478      !---------------------------------------------------------------- 
    590479 
    591       ll_border=.FALSE. 
    592       IF( PRESENT(ld_border) ) ll_border=ld_border 
    593       ! check td_dom and ld_border optionals parameters... 
    594       IF( ll_border .AND. PRESENT(td_dom) )THEN 
    595          CALL logger_error( "IOM MPP READ VAR VALUE: & 
    596          &                domain and border can't be both specify") 
    597       ENDIF 
    598  
    599       IF( ll_border )THEN 
    600             
    601          ! copy mpp structure 
    602          tl_mpp=td_mpp 
    603          ! forced to keep same id 
    604          tl_mpp%t_proc(:)%i_id=td_mpp%t_proc(:)%i_id 
    605  
    606          IF( ALL(td_mpp%t_proc(:)%l_ctr) )THEN 
    607             CALL logger_warn( "IOM MPP READ VAR VALUE: & 
    608             &               contour not define. look for it") 
    609             ! get contour 
    610             CALL mpp_get_contour( tl_mpp ) 
    611          ENDIF 
    612           
    613          ! Allocate space to hold variable value in structure 
    614          IF( ASSOCIATED(td_var%d_value) )THEN 
    615             DEALLOCATE(td_var%d_value)    
    616          ENDIF 
    617  
    618          DO jk=1,ip_maxdim 
    619             IF( .NOT. td_var%t_dim(jk)%l_use ) tl_mpp%t_dim(jk)%i_len = 1 
    620          ENDDO 
    621    
    622          ! use mpp global dimension  
    623          td_var%t_dim(:)%i_len=tl_mpp%t_dim(:)%i_len 
    624  
    625          ALLOCATE(td_var%d_value( td_var%t_dim(1)%i_len, & 
    626          &                        td_var%t_dim(2)%i_len, & 
    627          &                        td_var%t_dim(3)%i_len, & 
    628          &                        td_var%t_dim(4)%i_len),& 
    629          &        stat=il_status) 
    630          IF(il_status /= 0 )THEN 
    631  
    632            CALL logger_error( & 
    633             &  " IOM MPP READ VAR VALUE: not enough space to put variable "//& 
    634             &  TRIM(td_var%c_name)//& 
    635             &  " in variable structure") 
    636  
    637          ENDIF 
    638  
    639          ! read border processor 
    640          DO jk=1,tl_mpp%i_nproc 
    641             IF( tl_mpp%t_proc(jk)%l_ctr )THEN 
    642                  
    643                CALL logger_debug(" IOM MPP READ VAR VALUE: name "//TRIM(td_var%c_name) ) 
    644                CALL logger_debug(" IOM MPP READ VAR VALUE: ndim "//TRIM(fct_str(td_var%i_ndim)) ) 
    645                tl_var=iom_read_var( tl_mpp%t_proc(jk), td_var%c_name ) 
    646  
    647                ! get processor indices 
    648                il_ind(:)=mpp_get_proc_index( tl_mpp, jk ) 
    649                il_i1p = il_ind(1) 
    650                il_i2p = il_ind(2) 
    651                il_j1p = il_ind(3) 
    652                il_j2p = il_ind(4) 
    653  
    654                IF( .NOT. td_var%t_dim(1)%l_use )THEN 
    655                   il_i1p=1  
    656                   il_i2p=1  
    657                ENDIF 
    658  
    659                IF( .NOT. td_var%t_dim(2)%l_use )THEN 
    660                   il_j1p=1  
    661                   il_j2p=1  
    662                ENDIF 
    663  
    664                ! replace value in mpp domain 
    665                td_var%d_value(il_i1p:il_i2p,il_j1p:il_j2p,:,:) = & 
    666                &  tl_var%d_value(:,:,:,:) 
    667  
    668                ! clean variable 
    669                CALL var_clean(tl_var) 
    670             ENDIF 
    671          ENDDO 
    672  
    673       ENDIF 
    674  
    675       IF( PRESENT(td_dom) )THEN 
    676  
    677          ! copy mpp structure 
    678          tl_mpp=td_mpp 
    679          ! forced to keep same id 
    680          tl_mpp%t_proc(:)%i_id=td_mpp%t_proc(:)%i_id          
    681  
    682          IF( ALL(.NOT. td_mpp%t_proc(:)%l_use) )THEN 
    683             CALL logger_warn( "IOM MPP READ VAR VALUE: & 
    684             &               processor to be used not defined. look for it") 
    685             ! get processor to be used 
    686             CALL mpp_get_use( tl_mpp, td_dom ) 
    687          ENDIF 
    688  
    689          ! Allocate space to hold variable value in structure 
    690          IF( ASSOCIATED(td_var%d_value) )THEN 
    691             DEALLOCATE(td_var%d_value)    
    692          ENDIF 
    693           
    694          tl_dom=td_dom 
    695          DO jk=1,ip_maxdim 
    696             IF( .NOT. td_var%t_dim(jk)%l_use ) tl_dom%t_dim(jk)%i_len = 1 
    697          ENDDO 
    698  
    699          ! use domain dimension  
    700          td_var%t_dim(1:2)%i_len=tl_dom%t_dim(1:2)%i_len 
    701  
    702          ALLOCATE(td_var%d_value( tl_dom%t_dim(1)%i_len, & 
    703          &                        tl_dom%t_dim(2)%i_len, & 
    704          &                        td_var%t_dim(3)%i_len, & 
    705          &                        td_var%t_dim(4)%i_len),& 
    706          &        stat=il_status) 
    707          IF(il_status /= 0 )THEN 
    708  
    709            CALL logger_error( & 
    710             &  " IOM MPP READ VAR VALUE: not enough space to put variable "//& 
    711             &  TRIM(td_var%c_name)//& 
    712             &  " in variable structure") 
    713  
    714          ENDIF 
    715          CALL logger_debug("IOM MPP READ VAR VALUE: shape ("//& 
    716          &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=1)))//","//& 
    717          &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=2)))//","//& 
    718          &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=3)))//","//& 
    719          &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=4)))//")" )          
    720          ! FillValue by default 
    721          td_var%d_value(:,:,:,:)=td_var%d_fill 
    722  
    723          IF( tl_dom%i_jmin < tl_dom%i_jmax )THEN 
    724          ! no north pole 
    725  
    726             IF( tl_dom%i_imin == 1 .AND. & 
    727             &   tl_dom%i_imax == tl_dom%t_dim0(1)%i_len )THEN 
    728             ! east west cyclic 
    729  
    730                CALL iom_mpp__no_pole_cyclic(tl_mpp, td_var, tl_dom) 
    731  
    732             ELSEIF( tl_dom%i_imin < tl_dom%i_imax )THEN 
    733             ! no east west overlap 
    734                 
    735                CALL iom_mpp__no_pole_no_overlap(tl_mpp, td_var, tl_dom) 
    736  
    737                ! no more EW overlap in variable 
    738                td_var%i_ew=-1 
    739  
    740             ELSEIF( tl_dom%i_imin > tl_dom%i_imax )THEN 
    741             ! east west overlap 
    742  
    743                CALL iom_mpp__no_pole_overlap(tl_mpp, td_var, tl_dom) 
    744  
    745                ! no more EW overlap in variable 
    746                td_var%i_ew=-1 
    747  
    748             ELSE 
    749  
    750                CALL logger_error(" IOM MPP READ VAR VALUE: invalid domain definition.") 
    751  
    752             ENDIF 
    753  
    754          ELSE ! tl_dom%i_jmin >= tl_dom%i_jmax 
    755          ! north pole 
    756  
    757          CALL logger_error("IOM MPP READ VAR VALUE: siren is not able to do so now "//& 
    758          &  "maybe in the next release") 
    759          !   IF( tl_dom%i_imin < tl_dom%i_imax )THEN 
    760          !   ! no east west overlap 
    761  
    762          !      CALL iom_mpp__pole_no_overlap(tl_mpp, td_var, tl_dom) 
    763  
    764          !   ELSEIF(tl_dom%i_imin == tl_dom%i_imax)THEN 
    765          !   ! east west cyclic 
    766  
    767          !      CALL iom_mpp__pole_cyclic(tl_mpp, td_var, tl_dom) 
    768  
    769          !    ELSE ! tl_dom%i_imin > tl_dom%i_imax 
    770          !    ! east west overlap 
    771  
    772          !      CALL iom_mpp__pole_overlap(tl_mpp, td_var, tl_dom) 
    773  
    774          !   ENDIF 
    775          ENDIF 
    776  
    777       ENDIF 
    778  
    779       ! force to change _FillValue to avoid mistake  
    780       ! with dummy zero _FillValue 
    781       IF( td_var%d_fill == 0._dp )THEN 
    782          CALL var_chg_FillValue(td_var) 
    783       ENDIF       
    784  
    785    END SUBROUTINE iom_mpp__read_var_value 
    786    !> @endcode 
    787    !------------------------------------------------------------------- 
    788    !> @brief This subroutine read variable value 
    789    !> in an mpp structure. The output domain do not overlap 
    790    !> north fold boundary or east-west boundary. 
    791    !> 
    792    !> @details 
    793    !> If domain is given, read only domain. 
    794    !> If border is .TRUE., read only border processor 
    795    ! 
    796    !> @author J.Paul 
    797    !> - Nov, 2013- Initial Version 
    798    ! 
    799    !> @param[in] td_mpp    : mpp structure 
    800    !> @param[inout] td_var : variable structure 
    801    !> @param[in] td_dom    : domain structure 
    802    !> @return variable structure completed  
    803    ! 
    804    !> @todo 
    805    !------------------------------------------------------------------- 
    806    !> @code 
    807    SUBROUTINE iom_mpp__no_pole_no_overlap(td_mpp, td_var, td_dom ) 
    808       IMPLICIT NONE 
    809       ! Argument       
    810       TYPE(TMPP),  INTENT(IN)    :: td_mpp 
    811       TYPE(TVAR),  INTENT(INOUT) :: td_var 
    812       TYPE(TDOM),  INTENT(IN),   OPTIONAL :: td_dom 
    813  
    814       ! local variable 
    815       INTEGER(i4), DIMENSION(4) :: il_ind 
    816       INTEGER(i4)               :: il_i1p 
    817       INTEGER(i4)               :: il_j1p 
    818       INTEGER(i4)               :: il_i2p 
    819       INTEGER(i4)               :: il_j2p 
    820  
    821       INTEGER(i4)               :: il_i1 
    822       INTEGER(i4)               :: il_j1 
    823       INTEGER(i4)               :: il_i2 
    824       INTEGER(i4)               :: il_j2 
    825  
    826       INTEGER(i4), DIMENSION(4) :: il_start 
    827       INTEGER(i4), DIMENSION(4) :: il_count 
    828       TYPE(TVAR)                :: tl_var 
    829       TYPE(TDOM)                :: tl_dom 
    830  
    831       ! loop indices 
    832       INTEGER(i4) :: jk 
    833       !---------------------------------------------------------------- 
    834        
    835       ! change dimension length if not use 
    836       tl_dom=td_dom 
    837       IF( .NOT. td_var%t_dim(1)%l_use )THEN  
    838          tl_dom%i_imin=1 ; tl_dom%i_imax=1 
    839       ENDIF 
    840       IF( .NOT. td_var%t_dim(2)%l_use )THEN  
    841          tl_dom%i_jmin=1 ; tl_dom%i_jmax=1 
    842       ENDIF 
    843 !      IF( .NOT. td_var%t_dim(3)%l_use )THEN  
    844 !         tl_dom%i_kmin=1 ; tl_dom%i_kmax=1 
    845 !      ENDIF 
    846 !      IF( .NOT. td_var%t_dim(4)%l_use )THEN  
    847 !         tl_dom%i_lmin=1 ; tl_dom%i_lmax=1 
    848 !      ENDIF 
    849  
    850       ! read processor  
    851       DO jk=1,td_mpp%i_nproc 
    852          IF( td_mpp%t_proc(jk)%l_use )THEN 
    853  
    854             ! get processor indices 
    855             il_ind(:)=mpp_get_proc_index( td_mpp, jk ) 
    856             il_i1p = il_ind(1) 
    857             il_i2p = il_ind(2) 
    858             il_j1p = il_ind(3) 
    859             il_j2p = il_ind(4) 
    860  
    861             IF( .NOT. td_var%t_dim(1)%l_use )THEN 
    862                il_i1p=tl_dom%i_imin ; il_i2p=tl_dom%i_imax 
    863             ENDIF 
    864             IF( .NOT. td_var%t_dim(2)%l_use )THEN 
    865                il_j1p=tl_dom%i_jmin ; il_j2p=tl_dom%i_jmax 
    866             ENDIF 
    867  
    868             il_i1=MAX(il_i1p, tl_dom%i_imin) 
    869             il_i2=MIN(il_i2p, tl_dom%i_imax) 
    870  
    871             il_j1=MAX(il_j1p, tl_dom%i_jmin) 
    872             il_j2=MIN(il_j2p, tl_dom%i_jmax) 
    873  
    874             IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN 
    875  
    876                il_start(:)=(/ il_i1-il_i1p+1, & 
    877                &              il_j1-il_j1p+1, & 
    878                &              1,1 /) 
    879 !               &              tl_dom%i_kmin,  & 
    880 !               &              tl_dom%i_lmin /) 
    881  
    882                il_count(:)=(/ il_i2-il_i1+1,         & 
    883                &              il_j2-il_j1+1,         & 
    884                &              td_var%t_dim(3)%i_len, & 
    885                &              td_var%t_dim(4)%i_len /) 
    886 !               &              tl_dom%t_dim(3)%i_len, & 
    887 !               &              tl_dom%t_dim(4)%i_len /) 
    888  
    889                tl_var=iom_read_var( td_mpp%t_proc(jk), td_var%c_name,& 
    890                &                    il_start(:), il_count(:) ) 
    891  
    892                ! replace value in output variable structure 
    893                td_var%d_value( il_i1 - tl_dom%i_imin + 1 : & 
    894                &               il_i2 - tl_dom%i_imin + 1, & 
    895                &               il_j1 - tl_dom%i_jmin + 1 : & 
    896                &               il_j2 - tl_dom%i_jmin + 1, & 
    897                &               :,:) = tl_var%d_value(:,:,:,:) 
    898  
    899             ENDIF 
    900  
    901          ENDIF 
     480      il_start(:)=1 
     481      IF( PRESENT(id_start) ) il_start(:)=id_start(:) 
     482 
     483      il_count(:)=td_mpp%t_dim(:)%i_len 
     484      IF( PRESENT(id_count) ) il_count(:)=id_count(:) 
     485 
     486      CALL logger_debug("IOM MPP READ VAR VALUE: start "//& 
     487               &  TRIM(fct_str(il_start(jp_I)))//","//& 
     488               &  TRIM(fct_str(il_start(jp_J)))//","//& 
     489               &  TRIM(fct_str(il_start(jp_K)))//","//& 
     490               &  TRIM(fct_str(il_start(jp_L))) ) 
     491      CALL logger_debug("IOM MPP READ VAR VALUE: count "//& 
     492               &  TRIM(fct_str(il_count(jp_I)))//","//& 
     493               &  TRIM(fct_str(il_count(jp_J)))//","//& 
     494               &  TRIM(fct_str(il_count(jp_K)))//","//& 
     495               &  TRIM(fct_str(il_count(jp_L))) ) 
     496 
     497      DO jk=1,ip_maxdim 
     498         IF( .NOT. td_var%t_dim(jk)%l_use )THEN 
     499            il_start(jk) = 1 
     500            il_count(jk) = 1 
     501         ENDIF 
     502 
     503         il_end(jk)=il_start(jk)+il_count(jk)-1 
    902504      ENDDO 
    903505 
    904    END SUBROUTINE iom_mpp__no_pole_no_overlap 
    905    !> @endcode 
    906    !------------------------------------------------------------------- 
    907    !> @brief This subroutine read variable value 
    908    !> in an mpp structure. The output domain do not overlap north fold boundary. 
    909    !> However it uses cyclic east-west boundary. 
    910    !> 
    911    !> @details 
    912    !> If domain is given, read only domain. 
    913    !> If border is .TRUE., read only border processor 
    914    ! 
    915    !> @author J.Paul 
    916    !> - Nov, 2013- Initial Version 
    917    ! 
    918    !> @param[in] td_mpp    : mpp structure 
    919    !> @param[inout] td_var : variable structure 
    920    !> @param[in] td_dom    : domain structure 
    921    !> @return variable structure completed  
    922    ! 
    923    !> @todo 
    924    !------------------------------------------------------------------- 
    925    !> @code 
    926    SUBROUTINE iom_mpp__no_pole_cyclic(td_mpp, td_var, td_dom ) 
    927       IMPLICIT NONE 
    928       ! Argument       
    929       TYPE(TMPP),   INTENT(IN   ) :: td_mpp 
    930       TYPE(TVAR),   INTENT(INOUT) :: td_var 
    931       TYPE(TDOM),   INTENT(IN   ), OPTIONAL :: td_dom 
    932  
    933       ! local variable 
    934       INTEGER(i4), DIMENSION(4) :: il_ind 
    935       INTEGER(i4)               :: il_i1p 
    936       INTEGER(i4)               :: il_j1p 
    937       INTEGER(i4)               :: il_i2p 
    938       INTEGER(i4)               :: il_j2p 
    939  
    940       INTEGER(i4)               :: il_i1 
    941       INTEGER(i4)               :: il_j1 
    942       INTEGER(i4)               :: il_i2 
    943       INTEGER(i4)               :: il_j2 
    944  
    945       INTEGER(i4), DIMENSION(4) :: il_start 
    946       INTEGER(i4), DIMENSION(4) :: il_count 
    947       TYPE(TVAR)                :: tl_var 
    948       TYPE(TDOM)                :: tl_dom 
    949  
    950       ! loop indices 
    951       INTEGER(i4) :: jk 
    952       !---------------------------------------------------------------- 
    953  
    954       ! change dimension length if not use 
    955       tl_dom=td_dom 
    956       IF( .NOT. td_var%t_dim(1)%l_use )THEN  
    957          tl_dom%i_imin=1 ; tl_dom%i_imax=1 
    958       ENDIF 
    959       IF( .NOT. td_var%t_dim(2)%l_use )THEN  
    960          tl_dom%i_jmin=1 ; tl_dom%i_jmax=1 
    961       ENDIF 
    962 !      IF( .NOT. td_var%t_dim(3)%l_use )THEN  
    963 !         tl_dom%i_kmin=1 ; tl_dom%i_kmax=1 
    964 !      ENDIF 
    965 !      IF( .NOT. td_var%t_dim(4)%l_use )THEN  
    966 !         tl_dom%i_lmin=1 ; tl_dom%i_lmax=1 
    967 !      ENDIF 
     506      IF( ANY(il_end(:) > td_mpp%t_dim(:)%i_len) )THEN 
     507            CALL logger_debug("IOM MPP READ VAR VALUE: start + count "//& 
     508               &  TRIM(fct_str(il_end(jp_I)))//","//& 
     509               &  TRIM(fct_str(il_end(jp_J)))//","//& 
     510               &  TRIM(fct_str(il_end(jp_K)))//","//& 
     511               &  TRIM(fct_str(il_end(jp_L))) ) 
     512            CALL logger_debug("IOM MPP READ VAR VALUE: dimension "//& 
     513               &  TRIM(fct_str(td_mpp%t_dim(jp_I)%i_len))//","//& 
     514               &  TRIM(fct_str(td_mpp%t_dim(jp_J)%i_len))//","//& 
     515               &  TRIM(fct_str(td_mpp%t_dim(jp_K)%i_len))//","//& 
     516               &  TRIM(fct_str(td_mpp%t_dim(jp_L)%i_len)) ) 
     517            CALL logger_fatal("IOM MPP READ VAR VALUE: start + count "//& 
     518            &                 "exceed dimension bound.") 
     519      ENDIF 
     520 
     521      ! use domain dimension  
     522      td_var%t_dim(:)%i_len=il_count(:) 
     523 
     524      ! Allocate space to hold variable value in structure 
     525      IF( ASSOCIATED(td_var%d_value) )THEN 
     526         DEALLOCATE(td_var%d_value)    
     527      ENDIF 
     528 
     529      ALLOCATE(td_var%d_value( il_count(1), & 
     530      &                        il_count(2), & 
     531      &                        il_count(3), & 
     532      &                        il_count(4)),& 
     533      &        stat=il_status) 
     534      IF(il_status /= 0 )THEN 
     535 
     536        CALL logger_error( & 
     537         &  " IOM MPP READ VAR VALUE: not enough space to put variable "//& 
     538         &  TRIM(td_var%c_name)//& 
     539         &  " in variable structure") 
     540 
     541      ENDIF 
     542 
     543      CALL logger_debug("IOM MPP READ VAR VALUE: shape ("//& 
     544      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=1)))//","//& 
     545      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=2)))//","//& 
     546      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=3)))//","//& 
     547      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=4)))//")" ) 
     548      ! FillValue by default 
     549      td_var%d_value(:,:,:,:)=td_var%d_fill 
    968550 
    969551      ! read processor  
    … …  
    977559            il_j1p = il_ind(3) 
    978560            il_j2p = il_ind(4) 
    979  
     561  
    980562            IF( .NOT. td_var%t_dim(1)%l_use )THEN 
    981                il_i1p=tl_dom%i_imin ; il_i2p=tl_dom%i_imax 
     563               il_i1p=il_start(1) ; il_i2p=il_end(1) 
    982564            ENDIF 
    983565            IF( .NOT. td_var%t_dim(2)%l_use )THEN 
    984                il_j1p=tl_dom%i_jmin ; il_j2p=tl_dom%i_jmax 
     566               il_j1p=il_start(2) ; il_j2p=il_end(2) 
     567            ENDIF             
     568             
     569            il_i1=MAX(il_i1p, il_start(1)) 
     570            il_i2=MIN(il_i2p, il_end(1)) 
     571 
     572            il_j1=MAX(il_j1p, il_start(2)) 
     573            il_j2=MIN(il_j2p, il_end(2)) 
     574 
     575            IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN 
     576               il_strt(:)=(/ il_i1-il_i1p+1, & 
     577               &             il_j1-il_j1p+1, & 
     578               &             1,1 /) 
     579 
     580               il_cnt(:)=(/ il_i2-il_i1+1,         & 
     581               &            il_j2-il_j1+1,         & 
     582               &            td_var%t_dim(3)%i_len, & 
     583               &            td_var%t_dim(4)%i_len /) 
     584 
     585               tl_var=iom_read_var( td_mpp%t_proc(jk), td_var%c_name,& 
     586               &                    il_strt(:), il_cnt(:) ) 
     587               ! replace value in output variable structure 
     588               td_var%d_value( il_i1 - il_start(1) + 1 : & 
     589               &               il_i2 - il_start(1) + 1,  & 
     590               &               il_j1 - il_start(2) + 1 : & 
     591               &               il_j2 - il_start(2) + 1,  & 
     592               &               :,:) = tl_var%d_value(:,:,:,:) 
     593 
     594               ! clean 
     595               CALL var_clean(tl_var) 
    985596            ENDIF 
    986597 
    987             il_i1=il_i1p 
    988             il_j1=MAX(il_j1p, td_dom%i_jmin) 
    989  
    990             il_i2=il_i2p 
    991             il_j2=MIN(il_j2p, td_dom%i_jmax) 
    992  
    993             IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN 
    994  
    995                il_start(:)=(/ il_i1,          & 
    996                &              il_j1-il_j1p+1, & 
    997                &              1,1 /) 
    998 !               &              tl_dom%i_kmin,  & 
    999 !               &              tl_dom%i_lmin /) 
    1000  
    1001                il_count(:)=(/ il_i2-il_i1+1,         & 
    1002                &              il_j2-il_j1+1,         & 
    1003                &              td_var%t_dim(3)%i_len, & 
    1004                &              td_var%t_dim(4)%i_len /) 
    1005 !               &              tl_dom%t_dim(3)%i_len, & 
    1006 !               &              tl_dom%t_dim(4)%i_len /) 
    1007  
    1008                tl_var=iom_read_var( td_mpp%t_proc(jk), td_var%c_name,& 
    1009                &                    il_start(:), il_count(:) ) 
    1010  
    1011                ! replace value in output variable structure 
    1012                td_var%d_value( il_i1 : il_i2,  & 
    1013                &               il_j1 - td_dom%i_jmin + 1 : & 
    1014                &               il_j2 - td_dom%i_jmin + 1,  & 
    1015                &               :,:) = tl_var%d_value(:,:,:,:) 
    1016  
    1017             ENDIF 
    1018  
    1019598         ENDIF 
    1020599      ENDDO 
    1021600 
    1022    END SUBROUTINE iom_mpp__no_pole_cyclic 
    1023    !> @endcode 
    1024    !------------------------------------------------------------------- 
    1025    !> @brief This subroutine read variable value 
    1026    !> in an mpp structure. The output domain do not overlap north fold boundary.  
    1027    !> However it overlaps east-west boundary.  
    1028    !> 
     601      IF( td_var%t_dim(1)%l_use .AND. & 
     602      &   td_var%t_dim(1)%i_len == td_mpp%t_dim(1)%i_len )THEN 
     603         IF( td_mpp%i_ew >= 0 )THEN 
     604            tl_att=att_init("ew_overlap",td_mpp%i_ew) 
     605            CALL var_move_att(td_var,tl_att) 
     606            ! clean  
     607            CALL att_clean(tl_att) 
     608         ENDIF 
     609      ENDIF 
     610 
     611      ! force to change _FillValue to avoid mistake  
     612      ! with dummy zero _FillValue 
     613      IF( td_var%d_fill == 0._dp )THEN 
     614         CALL var_chg_FillValue(td_var) 
     615      ENDIF       
     616 
     617   END SUBROUTINE iom_mpp__read_var_value 
     618   !------------------------------------------------------------------- 
     619   !> @brief This subroutine write files composing mpp structure. 
     620   ! 
    1029621   !> @details 
    1030    !> If domain is given, read only domain. 
    1031    !> If border is .TRUE., read only border processor 
     622   !> optionally, you could specify the dimension order (default 'xyzt') 
    1032623   ! 
    1033624   !> @author J.Paul 
    1034    !> - Nov, 2013- Initial Version 
    1035    ! 
    1036    !> @param[in] td_mpp    : mpp structure 
    1037    !> @param[inout] td_var : variable structure 
    1038    !> @param[in] td_dom    : domain structure 
    1039    !> @return variable structure completed  
    1040    ! 
    1041    !> @todo 
    1042    !------------------------------------------------------------------- 
    1043    !> @code 
    1044    SUBROUTINE iom_mpp__no_pole_overlap(td_mpp, td_var, td_dom ) 
     625   !> @date November, 2013 - Initial Version 
     626   !> @date July, 2015 - add dimension order option  
     627   ! 
     628   !> @param[inout] td_mpp mpp structure 
     629   !> @param[In] cd_dimorder dimension order 
     630   !------------------------------------------------------------------- 
     631   SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder) 
    1045632      IMPLICIT NONE 
    1046633      ! Argument       
    1047       TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    1048       TYPE(TVAR),   INTENT(INOUT) :: td_var 
    1049       TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom 
     634      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp 
     635      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder 
    1050636 
    1051637      ! local variable 
    1052       INTEGER(i4), DIMENSION(4) :: il_ind 
    1053       INTEGER(i4)               :: il_i1p 
    1054       INTEGER(i4)               :: il_j1p 
    1055       INTEGER(i4)               :: il_i2p 
    1056       INTEGER(i4)               :: il_j2p 
    1057  
    1058       INTEGER(i4)               :: il_i1 
    1059       INTEGER(i4)               :: il_j1 
    1060       INTEGER(i4)               :: il_i2 
    1061       INTEGER(i4)               :: il_j2 
    1062  
    1063       INTEGER(i4)               :: il_ioffset 
    1064  
    1065       INTEGER(i4), DIMENSION(4) :: il_start 
    1066       INTEGER(i4), DIMENSION(4) :: il_count 
    1067       TYPE(TVAR)                :: tl_var 
    1068       TYPE(TDOM)                :: tl_dom 
    1069  
    1070       ! loop indices 
    1071       INTEGER(i4) :: jk 
    1072       !---------------------------------------------------------------- 
    1073  
    1074       il_ioffset  = (td_mpp%t_dim(1)%i_len-2) - td_dom%i_imin + 1 
    1075  
    1076       ! change dimension length if not use 
    1077       tl_dom=td_dom 
    1078       IF( .NOT. td_var%t_dim(1)%l_use )THEN  
    1079          tl_dom%i_imin=1 ; tl_dom%i_imax=1 
    1080          il_ioffset=0 
    1081       ENDIF 
    1082       IF( .NOT. td_var%t_dim(2)%l_use )THEN  
    1083          tl_dom%i_jmin=1 ; tl_dom%i_jmax=1 
    1084       ENDIF 
    1085 !      IF( .NOT. td_var%t_dim(3)%l_use )THEN  
    1086 !         tl_dom%i_kmin=1 ; tl_dom%i_kmax=1 
    1087 !      ENDIF 
    1088 !      IF( .NOT. td_var%t_dim(4)%l_use )THEN  
    1089 !         tl_dom%i_lmin=1 ; tl_dom%i_lmax=1 
    1090 !      ENDIF 
    1091  
    1092       ! read processor  
    1093       DO jk=1,td_mpp%i_nproc 
    1094          IF( td_mpp%t_proc(jk)%l_use )THEN 
    1095               
    1096             ! get processor indices 
    1097             il_ind(:)=mpp_get_proc_index( td_mpp, jk ) 
    1098             il_i1p = il_ind(1) 
    1099             il_i2p = il_ind(2) 
    1100             il_j1p = il_ind(3) 
    1101             il_j2p = il_ind(4) 
    1102  
    1103             IF( .NOT. td_var%t_dim(1)%l_use )THEN 
    1104                il_i1p=tl_dom%i_imin ; il_i2p=tl_dom%i_imax 
    1105             ENDIF 
    1106             IF( .NOT. td_var%t_dim(2)%l_use )THEN 
    1107                il_j1p=tl_dom%i_jmin ; il_j2p=tl_dom%i_jmax 
    1108             ENDIF 
    1109              
    1110             !!!!!! get first part of domain 
    1111             il_i1=MAX(il_i1p, td_dom%i_imin) 
    1112             il_j1=MAX(il_j1p, td_dom%i_jmin) 
    1113  
    1114             il_i2=MIN(il_i2p, td_mpp%t_dim(1)%i_len-td_var%i_ew) ! east-west overlap 
    1115             il_j2=MIN(il_j2p, td_dom%i_jmax) 
    1116  
    1117             IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN 
    1118  
    1119                il_start(:)=(/ il_i1-il_i1p+1, & 
    1120                &              il_j1-il_j1p+1, & 
    1121                &              1,1 /) 
    1122 !               &              tl_dom%i_kmin,  & 
    1123 !               &              tl_dom%i_lmin /) 
    1124  
    1125                il_count(:)=(/ il_i2-il_i1+1,         & 
    1126                &              il_j2-il_j1+1,         & 
    1127                &              td_var%t_dim(3)%i_len, & 
    1128                &              td_var%t_dim(4)%i_len /) 
    1129 !               &              tl_dom%t_dim(3)%i_len, & 
    1130 !               &              tl_dom%t_dim(4)%i_len /) 
    1131  
    1132                tl_var=iom_read_var( td_mpp%t_proc(jk), td_var%c_name,& 
    1133                &                    il_start(:), il_count(:) ) 
    1134  
    1135                ! replace value in output variable structure 
    1136                td_var%d_value( il_i1 - td_dom%i_imin + 1 : & 
    1137                &               il_i2 - td_dom%i_imin + 1,  & 
    1138                &               il_j1 - td_dom%i_jmin + 1 : & 
    1139                &               il_j2 - td_dom%i_jmin + 1,  & 
    1140                &               :,:) = tl_var%d_value(:,:,:,:) 
    1141  
    1142             ENDIF 
    1143  
    1144             !!!!! get second part of domain 
    1145             il_i1=MAX(il_i1p, 1) 
    1146             il_j1=MAX(il_j1p, td_dom%i_jmin) 
    1147  
    1148             il_i2=MIN(il_i2p, td_dom%i_imax) 
    1149             il_j2=MIN(il_j2p, td_dom%i_jmax) 
    1150  
    1151             IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN 
    1152  
    1153                il_start(:)=(/ il_i1,          & 
    1154                &              il_j1-il_j1p+1, & 
    1155                &              1,1 /) 
    1156 !               &              tl_dom%i_kmin,  & 
    1157 !               &              tl_dom%i_lmin /) 
    1158  
    1159                il_count(:)=(/ il_i2-il_i1+1,         & 
    1160                &              il_j2-il_j1+1,         & 
    1161                &              td_var%t_dim(3)%i_len, & 
    1162                &              td_var%t_dim(4)%i_len /) 
    1163 !               &              tl_dom%t_dim(3)%i_len, & 
    1164 !               &              tl_dom%t_dim(4)%i_len /) 
    1165  
    1166                tl_var=iom_read_var( td_mpp%t_proc(jk), td_var%c_name,& 
    1167                &                    il_start(:), il_count(:) ) 
    1168  
    1169                ! replace value in output variable structure 
    1170                td_var%d_value( il_ioffset + il_i1 :  & 
    1171                &               il_ioffset + il_i2,   & 
    1172                &               il_j1 - td_dom%i_jmin + 1 : & 
    1173                &               il_j2 - td_dom%i_jmin + 1,  & 
    1174                &               :,:) = tl_var%d_value(:,:,:,:) 
    1175  
    1176             ENDIF 
    1177  
    1178          ENDIF 
    1179       ENDDO 
    1180  
    1181    END SUBROUTINE iom_mpp__no_pole_overlap 
    1182    !> @endcode 
    1183    !------------------------------------------------------------------- 
    1184    !> @brief This subroutine read variable value 
    1185    !> in an mpp structure. The output domain overlaps 
    1186    !> north fold boundary. However it do not overlap east-west boundary. 
    1187    !> 
    1188    !> @details 
    1189    !> If domain is given, read only domain. 
    1190    ! 
    1191    !> @author J.Paul 
    1192    !> - Nov, 2013- Initial Version 
    1193    ! 
    1194    !> @param[in] td_mpp    : mpp structure 
    1195    !> @param[inout] td_var : variable structure 
    1196    !> @param[in] td_dom    : domain structure 
    1197    !> @return variable structure completed  
    1198    ! 
    1199    !> @todo 
    1200    !------------------------------------------------------------------- 
    1201    !> @code 
    1202 !   SUBROUTINE iom_mpp__pole_no_overlap(td_mpp, td_var, td_dom ) 
    1203 !      IMPLICIT NONE 
    1204 !      ! Argument       
    1205 !      TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    1206 !      TYPE(TVAR),   INTENT(INOUT) :: td_var 
    1207 !      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom 
    1208 ! 
    1209 !      ! local variable 
    1210 ! 
    1211 !      ! loop indices 
    1212 !      !---------------------------------------------------------------- 
    1213 ! 
    1214 !   END SUBROUTINE iom_mpp__pole_no_overlap 
    1215    !> @endcode 
    1216    !------------------------------------------------------------------- 
    1217    !> @brief This subroutine read variable value 
    1218    !> in an mpp structure. The output domain overlaps north fold boundary. 
    1219    !> and uses cyclic east-west boundary. 
    1220    !> 
    1221    !> @details 
    1222    !> If domain is given, read only domain. 
    1223    !> If border is .TRUE., read only border processor 
    1224    ! 
    1225    !> @author J.Paul 
    1226    !> - Nov, 2013- Initial Version 
    1227    ! 
    1228    !> @param[in] td_mpp    : mpp structure 
    1229    !> @param[inout] td_var : variable structure 
    1230    !> @param[in] td_dom    : domain structure 
    1231    !> @param[in] ld_border : read only border 
    1232    !> @return variable structure completed  
    1233    ! 
    1234    !> @todo 
    1235    !------------------------------------------------------------------- 
    1236    !> @code 
    1237 !   SUBROUTINE iom_mpp__pole_cyclic(td_mpp, td_var, td_dom ) 
    1238 !      IMPLICIT NONE 
    1239 !      ! Argument       
    1240 !      TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    1241 !      TYPE(TVAR),   INTENT(INOUT) :: td_var 
    1242 !      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom 
    1243 ! 
    1244 !      ! local variable 
    1245 ! 
    1246 !      ! loop indices 
    1247 !      !---------------------------------------------------------------- 
    1248 ! 
    1249 !   END SUBROUTINE iom_mpp__pole_cyclic 
    1250    !> @endcode 
    1251    !------------------------------------------------------------------- 
    1252    !> @brief This subroutine read variable value 
    1253    !> in an mpp structure. The output domain overlaps north fold boundary.  
    1254    !> and east-west boundary.  
    1255    !> 
    1256    !> @details 
    1257    !> If domain is given, read only domain. 
    1258    !> If border is .TRUE., read only border processor 
    1259    ! 
    1260    !> @author J.Paul 
    1261    !> - Nov, 2013- Initial Version 
    1262    ! 
    1263    !> @param[in] td_mpp    : mpp structure 
    1264    !> @param[inout] td_var : variable structure 
    1265    !> @param[in] td_dom    : domain structure 
    1266    !> @param[in] ld_border : read only border 
    1267    !> @return variable structure completed  
    1268    ! 
    1269    !> @todo 
    1270    !------------------------------------------------------------------- 
    1271    !> @code 
    1272 !   SUBROUTINE iom_mpp__pole_overlap(td_mpp, td_var, td_dom ) 
    1273 !      IMPLICIT NONE 
    1274 !      ! Argument       
    1275 !      TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    1276 !      TYPE(TVAR),   INTENT(INOUT) :: td_var 
    1277 !      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom 
    1278 ! 
    1279 !      ! local variable 
    1280 ! 
    1281 !      ! loop indices 
    1282 !      !---------------------------------------------------------------- 
    1283 ! 
    1284 !   END SUBROUTINE iom_mpp__pole_overlap 
    1285    !> @endcode 
    1286    !------------------------------------------------------------------- 
    1287    !> @brief This subroutine write mpp structure in opened files. 
    1288    ! 
    1289    !> @details 
    1290    ! 
    1291    !> @author J.Paul 
    1292    !> - Nov, 2013- Initial Version 
    1293    ! 
    1294    !> @param[in] td_file : file structure 
    1295    !------------------------------------------------------------------- 
    1296    !> @code 
    1297    SUBROUTINE iom_mpp_write_file(td_mpp) 
    1298       IMPLICIT NONE 
    1299       ! Argument       
    1300       TYPE(TMPP), INTENT(INOUT) :: td_mpp 
    1301  
    1302638      ! loop indices 
    1303639      INTEGER(i4) :: ji 
    … …  
    1312648         DO ji=1, td_mpp%i_nproc 
    1313649            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
    1314                CALL iom_write_file(td_mpp%t_proc(ji)) 
     650               !CALL file_del_att(td_mpp%t_proc(ji), 'periodicity') 
     651               !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap') 
     652 
     653               CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder) 
    1315654            ELSE 
    1316655               CALL logger_debug( " MPP WRITE: no id associated to file "//& 
    … …  
    1320659      ENDIF 
    1321660   END SUBROUTINE iom_mpp_write_file 
    1322    !> @endcode 
    1323661END MODULE iom_mpp 
Note: See TracChangeset for help on using the changeset viewer.