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 5240 for branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90 – NEMO

Ignore:
Timestamp:
2015-04-29T12:17:12+02:00 (9 years ago)
Author:
davestorkey
Message:

Update UKMO nn_etau_revision branch with trunk changes to rev 5107.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90

    r4213 r5240  
    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 
     
    4388! REVISION HISTORY: 
    4489!> @date Nov, 2013 - Initial Version 
    45 ! 
     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   !> - 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         ! if no processor file selected 
     164         ! force to open all files  
     165         IF( .NOT. ANY( td_mpp%t_proc(:)%l_use ) )THEN 
     166            td_mpp%t_proc(:)%l_use=.TRUE. 
     167         ENDIF 
     168 
     169         ! add suffix to mpp name 
     170         td_mpp%c_name=file_add_suffix( TRIM(td_mpp%c_name), & 
     171                                      & TRIM(td_mpp%c_type) ) 
     172 
     173         td_mpp%t_proc(:)%c_type=TRIM(td_mpp%c_type)  
     174         IF( td_mpp%i_nproc > 1 )THEN 
     175            DO ji=1,td_mpp%i_nproc 
     176               IF( td_mpp%t_proc(ji)%l_use )THEN 
     177 
     178                  SELECT CASE(TRIM(td_mpp%c_type)) 
     179                  CASE('cdf') 
     180                     cl_name=TRIM( file_rename(td_mpp%c_name, ji-1) ) 
     181                  CASE('dimg') 
    148182                     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 
     183                  CASE DEFAULT 
     184                     CALL logger_fatal("IOM MPP OPEN: can not open file "//& 
     185                     &  "of type "//TRIM(td_mpp%c_type)) 
     186                  END SELECT 
     187 
     188                  td_mpp%t_proc(ji)%c_name=TRIM(cl_name) 
     189 
     190                  CALL iom_open(td_mpp%t_proc(ji)) 
     191 
     192               ENDIF 
     193            ENDDO 
     194         ELSE ! td_mpp%i_nproc == 1  
     195               cl_name=TRIM( file_rename(td_mpp%c_name) ) 
     196               td_mpp%t_proc(1)%c_name=TRIM(cl_name) 
     197 
     198               CALL iom_open(td_mpp%t_proc(1)) 
     199         ENDIF 
     200 
     201         IF( PRESENT(id_ew) )THEN 
     202            td_mpp%i_ew=id_ew 
     203            ! add east west overlap to each variable 
     204            DO ji=1,td_mpp%i_nproc 
     205               WHERE(td_mpp%t_proc(ji)%t_var(:)%t_dim(1)%l_use) 
     206                  td_mpp%t_proc(ji)%t_var(:)%i_ew=td_mpp%i_ew 
     207               ENDWHERE 
     208            ENDDO 
     209         ENDIF 
     210 
     211         IF( PRESENT(id_perio) )THEN 
     212            td_mpp%i_perio=id_perio 
     213         ENDIF 
     214 
    178215      ENDIF 
    179216 
    180217   END SUBROUTINE iom_mpp_open 
    181    !> @endcode 
    182218   !------------------------------------------------------------------- 
    183219   !> @brief This subroutine create files, composing mpp structure to be used, 
    184    !> in write mode<br/> 
     220   !> in write mode. 
    185221   !>  
    186222   !> @author J.Paul 
    187    !> - Nov, 2013- Initial Version 
    188    ! 
    189    !> @param[inout] td_mpp : mpp structure 
    190    !------------------------------------------------------------------- 
    191    !> @code 
     223   !> - November, 2013- Initial Version 
     224   ! 
     225   !> @param[inout] td_mpp mpp structure 
     226   !------------------------------------------------------------------- 
    192227   SUBROUTINE iom_mpp_create(td_mpp) 
    193228      IMPLICIT NONE 
     
    209244 
    210245   END SUBROUTINE iom_mpp_create 
    211    !> @endcode 
    212246   !------------------------------------------------------------------- 
    213247   !> @brief This subroutine close files composing mpp structure. 
    214248   !> 
    215249   !> @author J.Paul 
    216    !> - Nov, 2013- Initial Version 
    217    ! 
    218    !> @param[in] td_mpp : mpp structure 
    219    !------------------------------------------------------------------- 
    220    !> @code 
     250   !> - November, 2013- Initial Version 
     251   ! 
     252   !> @param[in] td_mpp mpp structure 
     253   !------------------------------------------------------------------- 
    221254   SUBROUTINE iom_mpp_close(td_mpp) 
    222255      IMPLICIT NONE 
     
    239272            ENDIF 
    240273         ENDDO 
     274         td_mpp%t_proc(:)%l_use=.FALSE. 
    241275      ENDIF 
    242276 
    243277   END SUBROUTINE iom_mpp_close 
    244    !> @endcode 
    245278   !------------------------------------------------------------------- 
    246279   !> @brief This function read variable value in opened mpp files, 
    247    !> given variable id.</br/> 
     280   !> given variable id. 
    248281   !> 
    249282   !> @details 
    250    !> If domain is given, read only domain. 
    251    !> If border is .TRUE., read only border processor    
    252    !> 
    253    ! 
     283   !> Optionally start indices and number of point to be read could be specify. 
     284   !> as well as East West ovelap of the global domain. 
     285   !> 
    254286   !> @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 
     287   !> - November, 2013- Initial Version 
     288   !> @date October, 2014 
     289   !> - use start and count array instead of domain structure. 
     290   !> 
     291   !> @param[in] td_mpp    mpp structure 
     292   !> @param[in] id_varid  variable id 
     293   !> @param[in] id_start  index in the variable from which the data values  
     294   !> will be read 
     295   !> @param[in] id_count  number of indices selected along each dimension 
    261296   !> @return  variable structure  
    262297   !------------------------------------------------------------------- 
    263    !> @code 
    264298   TYPE(TVAR) FUNCTION iom_mpp__read_var_id(td_mpp, id_varid,& 
    265    &                                        td_dom, ld_border) 
     299   &                                        id_start, id_count) 
    266300      IMPLICIT NONE 
    267301      ! 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 
     302      TYPE(TMPP),                INTENT(IN) :: td_mpp 
     303      INTEGER(i4),               INTENT(IN) :: id_varid 
     304      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start 
     305      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count       
    272306 
    273307      ! local variable 
     
    288322            IF( il_ind(1) /= 0 )THEN 
    289323 
    290                iom_mpp__read_var_id=td_mpp%t_proc(1)%t_var(il_ind(1)) 
     324               iom_mpp__read_var_id=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1))) 
    291325 
    292326               !!! read variable value 
    293327               CALL iom_mpp__read_var_value(td_mpp, iom_mpp__read_var_id, & 
    294                &                            td_dom, ld_border) 
     328               &                            id_start, id_count) 
    295329 
    296330            ELSE 
     
    308342 
    309343   END FUNCTION iom_mpp__read_var_id 
    310    !> @endcode 
    311344   !------------------------------------------------------------------- 
    312345   !> @brief This function read variable value in opened mpp files,  
    313    !> given variable name or standard name.</br/> 
     346   !> given variable name or standard name. 
     347   !> 
    314348   !> @details 
    315    !> If domain is given, read only domain. 
    316    !> If border is .TRUE., read only border processor 
    317    ! 
    318    !> @details 
     349   !> Optionally start indices and number of point to be read could be specify. 
     350   !> as well as East West ovelap of the global domain. 
     351   !> 
    319352   !> look first for variable name. If it doesn't 
    320353   !> exist in file, look for variable standard name.<br/> 
     
    322355   ! 
    323356   !> @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  
     357   !> - November, 2013- Initial Version 
     358   !> @date October, 2014 
     359   !> - use start and count array instead of domain structure. 
     360   ! 
     361   !> @param[in] td_mpp    mpp structure 
     362   !> @param[in] cd_name   variable name 
     363   !> @param[in] id_start  index in the variable from which the data values  
     364   !> will be read 
     365   !> @param[in] id_count  number of indices selected along each dimension 
    330366   !> @return  variable structure  
    331367   !------------------------------------------------------------------- 
    332    !> @code 
    333368   TYPE(TVAR) FUNCTION iom_mpp__read_var_name(td_mpp, cd_name,    & 
    334    &                                          td_dom, ld_border  ) 
     369   &                                          id_start, id_count ) 
    335370      IMPLICIT NONE 
    336371      ! 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 
     372      TYPE(TMPP),                INTENT(IN) :: td_mpp 
     373      CHARACTER(LEN=*),          INTENT(IN) :: cd_name 
     374      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start 
     375      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count       
    341376 
    342377      ! local variable 
    343       INTEGER(i4)       :: il_varid 
     378      INTEGER(i4)       :: il_ind 
    344379      !---------------------------------------------------------------- 
    345380      ! check if mpp exist 
     
    351386      ELSE 
    352387 
    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) 
     388            il_ind=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name) 
     389            IF( il_ind /= 0 )THEN 
     390 
     391               iom_mpp__read_var_name=var_copy(td_mpp%t_proc(1)%t_var(il_ind)) 
    357392 
    358393               !!! read variable value 
    359394               CALL iom_mpp__read_var_value( td_mpp, & 
    360395               &                             iom_mpp__read_var_name, & 
    361                &                             td_dom, ld_border) 
     396               &                             id_start, id_count) 
    362397 
    363398            ELSE 
     
    372407       
    373408   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 
    511  
    512       ! local variable 
    513       INTEGER(i4)       :: il_ind 
    514       !---------------------------------------------------------------- 
    515       ! check if mpp exist 
    516       IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 
    517  
    518          CALL logger_error( " IOM MPP FILL VAR : domain decomposition not define "//& 
    519          &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    520  
    521       ELSE 
    522  
    523             il_ind=var_get_id( td_mpp%t_proc(1)%t_var(:), cd_name, cd_name) 
    524             IF( il_ind /= 0 )THEN 
    525  
    526                !!! 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) 
    530  
    531             ELSE 
    532  
    533                CALL logger_error( & 
    534                &  " IOM MPP FILL VAR : there is no variable with "//& 
    535                &  "name or standard name "//TRIM(cd_name)//& 
    536                &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name)) 
    537  
    538             ENDIF 
    539  
    540       ENDIF 
    541        
    542    END SUBROUTINE iom_mpp__fill_var_name 
    543    !> @endcode 
    544409   !------------------------------------------------------------------- 
    545410   !> @brief This subroutine read variable value 
     
    547412   !> 
    548413   !> @details 
    549    !> If domain is given, read only domain. 
    550    !> If border is .TRUE., read only border processor 
     414   !> Optionally start indices and number of point to be read could be specify. 
     415   !> as well as East West ovelap of the global domain. 
    551416   ! 
    552417   !> @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 
     418   !> - November, 2013- Initial Version 
     419   !> @date October, 2014 
     420   !> - use start and count array instead of domain structure. 
     421   !> 
     422   !> @param[in] td_mpp    mpp structure 
     423   !> @param[inout] td_var variable structure 
     424   !> @param[in] id_start  index in the variable from which the data values  
     425   !> will be read 
     426   !> @param[in] id_count  number of indices selected along each dimension 
     427   !------------------------------------------------------------------- 
    565428   SUBROUTINE iom_mpp__read_var_value(td_mpp, td_var, & 
    566    &                                  td_dom, ld_border ) 
     429   &                                  id_start, id_count ) 
    567430      IMPLICIT NONE 
    568431      ! Argument       
    569432      TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    570433      TYPE(TVAR),   INTENT(INOUT) :: td_var 
    571       TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom 
    572       LOGICAL,      INTENT(IN),   OPTIONAL :: ld_border 
     434      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_start 
     435      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_count       
    573436 
    574437      ! local variable 
     
    579442      INTEGER(i4)                       :: il_j1p 
    580443      INTEGER(i4)                       :: il_j2p 
    581  
    582       LOGICAL                           :: ll_border 
     444      INTEGER(i4)                       :: il_i1 
     445      INTEGER(i4)                       :: il_i2 
     446      INTEGER(i4)                       :: il_j1 
     447      INTEGER(i4)                       :: il_j2 
     448 
     449      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 
     450      INTEGER(i4), DIMENSION(ip_maxdim) :: il_end 
     451      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count       
     452 
     453      INTEGER(i4), DIMENSION(ip_maxdim) :: il_strt 
     454      INTEGER(i4), DIMENSION(ip_maxdim) :: il_cnt       
     455 
     456      TYPE(TATT)                        :: tl_att 
    583457      TYPE(TVAR)                        :: tl_var 
    584       TYPE(TMPP)                        :: tl_mpp 
    585       TYPE(TDOM)                        :: tl_dom 
    586458 
    587459      ! loop indices 
     
    589461      !---------------------------------------------------------------- 
    590462 
    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 
     463      il_start(:)=1 
     464      IF( PRESENT(id_start) ) il_start(:)=id_start(:) 
     465 
     466      il_count(:)=td_mpp%t_dim(:)%i_len 
     467      IF( PRESENT(id_count) ) il_count(:)=id_count(:) 
     468 
     469      DO jk=1,ip_maxdim 
     470         IF( .NOT. td_var%t_dim(jk)%l_use )THEN 
     471            il_start(jk) = 1 
     472            il_count(jk) = 1 
     473         ENDIF 
     474 
     475         il_end(jk)=il_start(jk)+il_count(jk)-1 
    902476      ENDDO 
    903477 
    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 
     478 
     479      IF( ANY(il_end(:) > td_mpp%t_dim(:)%i_len) )THEN 
     480            CALL logger_fatal("IOM MPP READ VAR VALUE: start + count "//& 
     481            &                 "exceed dimension bound.") 
     482      ENDIF 
     483 
     484      ! use domain dimension  
     485      td_var%t_dim(:)%i_len=il_count(:) 
     486 
     487      ! Allocate space to hold variable value in structure 
     488      IF( ASSOCIATED(td_var%d_value) )THEN 
     489         DEALLOCATE(td_var%d_value)    
     490      ENDIF 
     491 
     492      ALLOCATE(td_var%d_value( il_count(1), & 
     493      &                        il_count(2), & 
     494      &                        il_count(3), & 
     495      &                        il_count(4)),& 
     496      &        stat=il_status) 
     497      IF(il_status /= 0 )THEN 
     498 
     499        CALL logger_error( & 
     500         &  " IOM MPP READ VAR VALUE: not enough space to put variable "//& 
     501         &  TRIM(td_var%c_name)//& 
     502         &  " in variable structure") 
     503 
     504      ENDIF 
     505 
     506      CALL logger_debug("IOM MPP READ VAR VALUE: shape ("//& 
     507      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=1)))//","//& 
     508      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=2)))//","//& 
     509      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=3)))//","//& 
     510      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=4)))//")" ) 
     511      ! FillValue by default 
     512      td_var%d_value(:,:,:,:)=td_var%d_fill 
    968513 
    969514      ! read processor  
     
    977522            il_j1p = il_ind(3) 
    978523            il_j2p = il_ind(4) 
    979  
     524  
    980525            IF( .NOT. td_var%t_dim(1)%l_use )THEN 
    981                il_i1p=tl_dom%i_imin ; il_i2p=tl_dom%i_imax 
     526               il_i1p=il_start(1) ; il_i2p=il_end(1) 
    982527            ENDIF 
    983528            IF( .NOT. td_var%t_dim(2)%l_use )THEN 
    984                il_j1p=tl_dom%i_jmin ; il_j2p=tl_dom%i_jmax 
     529               il_j1p=il_start(2) ; il_j2p=il_end(2) 
     530            ENDIF             
     531             
     532            il_i1=MAX(il_i1p, il_start(1)) 
     533            il_i2=MIN(il_i2p, il_end(1)) 
     534 
     535            il_j1=MAX(il_j1p, il_start(2)) 
     536            il_j2=MIN(il_j2p, il_end(2)) 
     537 
     538            IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN 
     539               il_strt(:)=(/ il_i1-il_i1p+1, & 
     540               &             il_j1-il_j1p+1, & 
     541               &             1,1 /) 
     542 
     543               il_cnt(:)=(/ il_i2-il_i1+1,         & 
     544               &            il_j2-il_j1+1,         & 
     545               &            td_var%t_dim(3)%i_len, & 
     546               &            td_var%t_dim(4)%i_len /) 
     547 
     548               tl_var=iom_read_var( td_mpp%t_proc(jk), td_var%c_name,& 
     549               &                    il_strt(:), il_cnt(:) ) 
     550               ! replace value in output variable structure 
     551               td_var%d_value( il_i1 - il_start(1) + 1 : & 
     552               &               il_i2 - il_start(1) + 1,  & 
     553               &               il_j1 - il_start(2) + 1 : & 
     554               &               il_j2 - il_start(2) + 1,  & 
     555               &               :,:) = tl_var%d_value(:,:,:,:) 
     556 
     557               ! clean 
     558               CALL var_clean(tl_var) 
    985559            ENDIF 
    986560 
    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  
    1019561         ENDIF 
    1020562      ENDDO 
    1021563 
    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    !> 
     564      IF( td_var%t_dim(1)%l_use .AND. & 
     565      &   td_var%t_dim(1)%i_len == td_mpp%t_dim(1)%i_len )THEN 
     566         IF( td_mpp%i_ew >= 0 )THEN 
     567            tl_att=att_init("ew_overlap",td_mpp%i_ew) 
     568            CALL var_move_att(td_var,tl_att) 
     569            ! clean  
     570            CALL att_clean(tl_att) 
     571         ENDIF 
     572      ENDIF 
     573 
     574      ! force to change _FillValue to avoid mistake  
     575      ! with dummy zero _FillValue 
     576      IF( td_var%d_fill == 0._dp )THEN 
     577         CALL var_chg_FillValue(td_var) 
     578      ENDIF       
     579 
     580   END SUBROUTINE iom_mpp__read_var_value 
     581   !------------------------------------------------------------------- 
     582   !> @brief This subroutine write files composing mpp structure. 
     583   ! 
    1029584   !> @details 
    1030    !> If domain is given, read only domain. 
    1031    !> If border is .TRUE., read only border processor 
    1032585   ! 
    1033586   !> @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 ) 
    1045       IMPLICIT NONE 
    1046       ! Argument       
    1047       TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    1048       TYPE(TVAR),   INTENT(INOUT) :: td_var 
    1049       TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom 
    1050  
    1051       ! 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 
     587   !> - November, 2013- Initial Version 
     588   ! 
     589   !> @param[inout] td_mpp mpp structure 
     590   !------------------------------------------------------------------- 
    1297591   SUBROUTINE iom_mpp_write_file(td_mpp) 
    1298592      IMPLICIT NONE 
     
    1300594      TYPE(TMPP), INTENT(INOUT) :: td_mpp 
    1301595 
     596      ! local variable 
    1302597      ! loop indices 
    1303598      INTEGER(i4) :: ji 
     
    1312607         DO ji=1, td_mpp%i_nproc 
    1313608            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
     609               !CALL file_del_att(td_mpp%t_proc(ji), 'periodicity') 
     610               !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap') 
     611 
    1314612               CALL iom_write_file(td_mpp%t_proc(ji)) 
    1315613            ELSE 
     
    1320618      ENDIF 
    1321619   END SUBROUTINE iom_mpp_write_file 
    1322    !> @endcode 
    1323620END MODULE iom_mpp 
Note: See TracChangeset for help on using the changeset viewer.