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.
iom_mpp.f90 in branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90 @ 4213

Last change on this file since 4213 was 4213, checked in by cbricaud, 10 years ago

first draft of the CONFIGURATION MANAGER demonstrator
File size: 45.9 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! MODULE: iom_mpp
6!
7! DESCRIPTION:
8!> @brief massively parallel processing Input/Output manager : 
9!> Library to read/write mpp files<br/>
10!>
11!> @details
12!>
13!>    to open mpp files (only file to be used (see mpp_get_use)
14!>    will be open):<br/>
15!>    CALL iom_mpp_open(td_mpp)
16!>       - td_mpp is a mpp structure
17!>
18!>    to creates mpp files:<br/>
19!>    CALL iom_mpp_create(td_mpp)
20!>       - td_mpp is a mpp structure
21!>
22!>    to write in mpp files :<br/>
23!>    CALL  iom_mpp_write_file(td_mpp)
24!>       - td_mpp is a mpp structure
25!>
26!>    to close mpp files:<br/>
27!>    CALL iom_mpp_close(td_mpp)
28!>
29!>    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] )
32!>       - td_mpp is a mpp structure
33!>       - 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!>
40!>
41!> @author
42!> J.Paul
43! REVISION HISTORY:
44!> @date Nov, 2013 - Initial Version
45!
46!> @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
54!----------------------------------------------------------------------
55MODULE iom_mpp
56   USE netcdf                          ! nf90 library
57   USE kind                            ! F90 kind parameter
58   USE fct                             ! basic useful function
59   USE logger                             ! log file manager
60   USE dim                             ! dimension manager
61   USE att                             ! attribute manager
62   USE var                             ! variable manager
63   USE file                            ! file manager
64   USE iom                             ! I/O manager
65   USE mpp                             ! mpp manager
66   USE dom                             ! domain manager
67   IMPLICIT NONE
68   PRIVATE
69   ! NOTE_avoid_public_variables_if_possible
70
71   ! 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
74   PUBLIC :: iom_mpp_close                   !< close file composing mpp structure
75   PUBLIC :: iom_mpp_read_var                !< read one variable in an mpp structure
76   PUBLIC :: iom_mpp_fill_var                !< fill variable value in mpp structure
77   PUBLIC :: iom_mpp_write_file              !< write mpp structure in files
78
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
92   END INTERFACE iom_mpp_read_var
93
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
100CONTAINS
101   !-------------------------------------------------------------------
102   !> @brief This subroutine open files composing mpp structure to be used<br/>
103   !> If try to open a file in write mode that did not exist, create it.<br/>
104   !>
105   !> If file already exist, get information about:
106   !> - the number of variables
107   !> - the number of dimensions
108   !> - the number of global attributes
109   !> - the ID of the unlimited dimension
110   !> - the file format
111   !> and finally read dimensions.
112   !>
113   !> @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)
120      IMPLICIT NONE
121      ! Argument     
122      TYPE(TMPP), INTENT(INOUT)  :: td_mpp
123
124      ! local variable
125      CHARACTER(LEN=lc) :: cl_name
126
127      ! loop indices
128      INTEGER(i4) :: ji
129      !----------------------------------------------------------------
130      ! check if mpp exist
131      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
132
133         CALL logger_error( " IOM MPP OPEN: domain decomposition not define "//&
134         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
135
136      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
148                     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
178      ENDIF
179
180   END SUBROUTINE iom_mpp_open
181   !> @endcode
182   !-------------------------------------------------------------------
183   !> @brief This subroutine create files, composing mpp structure to be used,
184   !> in write mode<br/>
185   !>
186   !> @author J.Paul
187   !> - Nov, 2013- Initial Version
188   !
189   !> @param[inout] td_mpp : mpp structure
190   !-------------------------------------------------------------------
191   !> @code
192   SUBROUTINE iom_mpp_create(td_mpp)
193      IMPLICIT NONE
194      ! Argument     
195      TYPE(TMPP), INTENT(INOUT)  :: td_mpp
196      !----------------------------------------------------------------
197      ! check if mpp exist
198      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
199
200         CALL logger_error( " IOM MPP CREATE: domain decomposition not define "//&
201         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
202
203      ELSE
204         ! forced to open in write mode
205         td_mpp%t_proc(:)%l_wrt=.TRUE.
206         td_mpp%t_proc(:)%l_use=.TRUE.
207         CALL iom_mpp_open(td_mpp)
208      ENDIF
209
210   END SUBROUTINE iom_mpp_create
211   !> @endcode
212   !-------------------------------------------------------------------
213   !> @brief This subroutine close files composing mpp structure.
214   !>
215   !> @author J.Paul
216   !> - Nov, 2013- Initial Version
217   !
218   !> @param[in] td_mpp : mpp structure
219   !-------------------------------------------------------------------
220   !> @code
221   SUBROUTINE iom_mpp_close(td_mpp)
222      IMPLICIT NONE
223      ! Argument     
224      TYPE(TMPP), INTENT(INOUT) :: td_mpp
225
226      ! loop indices
227      INTEGER(i4) :: ji
228      !----------------------------------------------------------------
229      ! check if mpp exist
230      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
231
232         CALL logger_error( " IOM MPP CLOSE: domain decomposition not define "//&
233         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
234
235      ELSE
236         DO ji=1,td_mpp%i_nproc
237            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
238               CALL iom_close(td_mpp%t_proc(ji))
239            ENDIF
240         ENDDO
241      ENDIF
242
243   END SUBROUTINE iom_mpp_close
244   !> @endcode
245   !-------------------------------------------------------------------
246   !> @brief This function read variable value in opened mpp files,
247   !> given variable id.</br/>
248   !>
249   !> @details
250   !> If domain is given, read only domain.
251   !> If border is .TRUE., read only border processor   
252   !>
253   !
254   !> @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
261   !> @return  variable structure
262   !-------------------------------------------------------------------
263   !> @code
264   TYPE(TVAR) FUNCTION iom_mpp__read_var_id(td_mpp, id_varid,&
265   &                                        td_dom, ld_border)
266      IMPLICIT NONE
267      ! 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
272
273      ! local variable
274      INTEGER(i4), DIMENSION(1) :: il_ind
275      !----------------------------------------------------------------
276      ! check if mpp exist
277      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
278
279         CALL logger_error( " IOM MPP READ VAR: domain decomposition not define "//&
280         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
281
282      ELSE
283
284         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN
285            ! look for variable id
286            il_ind(:)=MINLOC( td_mpp%t_proc(1)%t_var(:)%i_id, &
287            &           mask=(td_mpp%t_proc(1)%t_var(:)%i_id==id_varid))
288            IF( il_ind(1) /= 0 )THEN
289
290               iom_mpp__read_var_id=td_mpp%t_proc(1)%t_var(il_ind(1))
291
292               !!! read variable value
293               CALL iom_mpp__read_var_value(td_mpp, iom_mpp__read_var_id, &
294               &                            td_dom, ld_border)
295
296            ELSE
297               CALL logger_error( &
298               &  " IOM MPP READ VAR: there is no variable with id "//&
299               &  TRIM(fct_str(id_varid))//" in processor/file "//&
300               &  TRIM(td_mpp%t_proc(1)%c_name))
301            ENDIF
302         ELSE
303            CALL logger_error(" IOM MPP READ VAR: can't read variable, mpp "//&
304            &  TRIM(td_mpp%c_name)//" not opened")
305         ENDIF
306
307      ENDIF
308
309   END FUNCTION iom_mpp__read_var_id
310   !> @endcode
311   !-------------------------------------------------------------------
312   !> @brief This function read variable value in opened mpp files,
313   !> given variable name or standard name.</br/>
314   !> @details
315   !> If domain is given, read only domain.
316   !> If border is .TRUE., read only border processor
317   !
318   !> @details
319   !> look first for variable name. If it doesn't
320   !> exist in file, look for variable standard name.<br/>
321   !> If variable name is not present, check variable standard name.<br/>
322   !
323   !> @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
330   !> @return  variable structure
331   !-------------------------------------------------------------------
332   !> @code
333   TYPE(TVAR) FUNCTION iom_mpp__read_var_name(td_mpp, cd_name,    &
334   &                                          td_dom, ld_border   )
335      IMPLICIT NONE
336      ! 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
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
544   !-------------------------------------------------------------------
545   !> @brief This subroutine read variable value
546   !> in an mpp structure.
547   !>
548   !> @details
549   !> If domain is given, read only domain.
550   !> If border is .TRUE., read only border processor
551   !
552   !> @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
565   SUBROUTINE iom_mpp__read_var_value(td_mpp, td_var, &
566   &                                  td_dom, ld_border )
567      IMPLICIT NONE
568      ! Argument     
569      TYPE(TMPP),   INTENT(IN)    :: td_mpp
570      TYPE(TVAR),   INTENT(INOUT) :: td_var
571      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
572      LOGICAL,      INTENT(IN),   OPTIONAL :: ld_border
573
574      ! local variable
575      INTEGER(i4)                       :: il_status
576      INTEGER(i4), DIMENSION(4)         :: il_ind
577      INTEGER(i4)                       :: il_i1p
578      INTEGER(i4)                       :: il_i2p
579      INTEGER(i4)                       :: il_j1p
580      INTEGER(i4)                       :: il_j2p
581
582      LOGICAL                           :: ll_border
583      TYPE(TVAR)                        :: tl_var
584      TYPE(TMPP)                        :: tl_mpp
585      TYPE(TDOM)                        :: tl_dom
586
587      ! loop indices
588      INTEGER(i4) :: jk
589      !----------------------------------------------------------------
590
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
902      ENDDO
903
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
968
969      ! read processor
970      DO jk=1,td_mpp%i_nproc
971         IF( td_mpp%t_proc(jk)%l_use )THEN
972             
973            ! get processor indices
974            il_ind(:)=mpp_get_proc_index( td_mpp, jk )
975            il_i1p = il_ind(1)
976            il_i2p = il_ind(2)
977            il_j1p = il_ind(3)
978            il_j2p = il_ind(4)
979
980            IF( .NOT. td_var%t_dim(1)%l_use )THEN
981               il_i1p=tl_dom%i_imin ; il_i2p=tl_dom%i_imax
982            ENDIF
983            IF( .NOT. td_var%t_dim(2)%l_use )THEN
984               il_j1p=tl_dom%i_jmin ; il_j2p=tl_dom%i_jmax
985            ENDIF
986
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
1019         ENDIF
1020      ENDDO
1021
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   !>
1029   !> @details
1030   !> If domain is given, read only domain.
1031   !> If border is .TRUE., read only border processor
1032   !
1033   !> @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
1297   SUBROUTINE iom_mpp_write_file(td_mpp)
1298      IMPLICIT NONE
1299      ! Argument     
1300      TYPE(TMPP), INTENT(INOUT) :: td_mpp
1301
1302      ! loop indices
1303      INTEGER(i4) :: ji
1304      !----------------------------------------------------------------
1305      ! check if mpp exist
1306      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
1307
1308         CALL logger_error( " MPP WRITE: domain decomposition not define "//&
1309         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
1310
1311      ELSE
1312         DO ji=1, td_mpp%i_nproc
1313            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
1314               CALL iom_write_file(td_mpp%t_proc(ji))
1315            ELSE
1316               CALL logger_debug( " MPP WRITE: no id associated to file "//&
1317               &              TRIM(td_mpp%t_proc(ji)%c_name) )
1318            ENDIF
1319         ENDDO
1320      ENDIF
1321   END SUBROUTINE iom_mpp_write_file
1322   !> @endcode
1323END MODULE iom_mpp
Note: See TracBrowser for help on using the repository browser.