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/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90 @ 10248

Last change on this file since 10248 was 10248, checked in by kingr, 5 years ago

Merged 2015/nemo_v3_6_STABLE@6232

File size: 24.1 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 This module manage massively parallel processing Input/Output manager.
9!> Library to read/write mpp files.
10!>
11!> @details
12!>    to open mpp files (only file to be used (see mpp_get_use)
13!>    will be open):<br/>
14!> @code
15!>    CALL iom_mpp_open(td_mpp)
16!> @endcode
17!>       - td_mpp is a mpp structure
18!>
19!>    to creates mpp files:<br/>
20!> @code
21!>    CALL iom_mpp_create(td_mpp)
22!> @endcode
23!>       - td_mpp is a mpp structure
24!>
25!>    to write in mpp files :<br/>
26!> @code
27!>    CALL  iom_mpp_write_file(td_mpp)
28!> @endcode
29!>       - td_mpp is a mpp structure
30!>
31!>    to close mpp files:<br/>
32!> @code
33!>    CALL iom_mpp_close(td_mpp)
34!> @endcode
35!>
36!>    to read one variable in an mpp files:<br/>
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
44!>       - td_mpp is a mpp structure
45!>       - id_varid is a variable id
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
85!>
86!> @author
87!> J.Paul
88! REVISION HISTORY:
89!> @date November, 2013 - Initial Version
90!>
91!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
92!----------------------------------------------------------------------
93MODULE iom_mpp
94   USE netcdf                          ! nf90 library
95   USE global                          ! global parameter
96   USE kind                            ! F90 kind parameter
97   USE fct                             ! basic useful function
98   USE logger                          ! log file manager
99   USE dim                             ! dimension manager
100   USE att                             ! attribute manager
101   USE var                             ! variable manager
102   USE file                            ! file manager
103   USE iom                             ! I/O manager
104   USE mpp                             ! mpp manager
105   IMPLICIT NONE
106   ! NOTE_avoid_public_variables_if_possible
107
108   ! function and subroutine
109   PUBLIC :: iom_mpp_open                    !< open all files composing mpp structure
110   PUBLIC :: iom_mpp_create                  !< creates files composing mpp structure
111   PUBLIC :: iom_mpp_close                   !< close file composing mpp structure
112   PUBLIC :: iom_mpp_read_var                !< read one variable in an mpp structure
113   PUBLIC :: iom_mpp_write_file              !< write mpp structure in files
114
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
122   END INTERFACE iom_mpp_read_var
123
124CONTAINS
125   !-------------------------------------------------------------------
126   !> @brief This subroutine open files composing mpp structure to be used.
127   !> @details
128   !> If try to open a file in write mode that did not exist, create it.<br/>
129   !>
130   !> If file already exist, get information about:
131   !> - the number of variables
132   !> - the number of dimensions
133   !> - the number of global attributes
134   !> - the ID of the unlimited dimension
135   !> - the file format
136   !> and finally read dimensions.
137   !>
138   !> @author J.Paul
139   !> @date November, 2013 - Initial Version
140   !
141   !> @param[inout] td_mpp mpp structure
142   !-------------------------------------------------------------------
143   SUBROUTINE iom_mpp_open(td_mpp, id_perio, id_ew)
144      IMPLICIT NONE
145      ! Argument     
146      TYPE(TMPP) , INTENT(INOUT)  :: td_mpp
147      INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio
148      INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew
149
150      ! local variable
151      CHARACTER(LEN=lc) :: cl_name
152
153      ! loop indices
154      INTEGER(i4) :: ji
155      !----------------------------------------------------------------
156      ! check if mpp exist
157      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
158
159         CALL logger_error( " IOM MPP OPEN: domain decomposition not define "//&
160         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
161
162      ELSE
163         !
164         td_mpp%i_id=1
165
166         ! if no processor file selected
167         ! force to open all files
168         IF( .NOT. ANY( td_mpp%t_proc(:)%l_use ) )THEN
169            td_mpp%t_proc(:)%l_use=.TRUE.
170         ENDIF
171
172         ! add suffix to mpp name
173         td_mpp%c_name=file_add_suffix( TRIM(td_mpp%c_name), &
174                                      & TRIM(td_mpp%c_type) )
175
176         td_mpp%t_proc(:)%c_type=TRIM(td_mpp%c_type) 
177         IF( td_mpp%i_nproc > 1 )THEN
178            DO ji=1,td_mpp%i_nproc
179               IF( td_mpp%t_proc(ji)%l_use )THEN
180
181                  SELECT CASE(TRIM(td_mpp%c_type))
182                  CASE('cdf')
183                     cl_name=TRIM( file_rename(td_mpp%c_name, ji-1) )
184                  CASE('dimg')
185                     cl_name=TRIM( file_rename(td_mpp%c_name, ji) )
186                  CASE DEFAULT
187                     CALL logger_fatal("IOM MPP OPEN: can not open file "//&
188                     &  "of type "//TRIM(td_mpp%c_type))
189                  END SELECT
190
191                  td_mpp%t_proc(ji)%c_name=TRIM(cl_name)
192
193                  CALL iom_open(td_mpp%t_proc(ji))
194
195               ENDIF
196            ENDDO
197         ELSE ! td_mpp%i_nproc == 1
198               cl_name=TRIM( file_rename(td_mpp%c_name) )
199               td_mpp%t_proc(1)%c_name=TRIM(cl_name)
200
201               CALL iom_open(td_mpp%t_proc(1))
202         ENDIF
203
204         IF( PRESENT(id_ew) )THEN
205            td_mpp%i_ew=id_ew
206            ! add east west overlap to each variable
207            DO ji=1,td_mpp%i_nproc
208               WHERE(td_mpp%t_proc(ji)%t_var(:)%t_dim(1)%l_use)
209                  td_mpp%t_proc(ji)%t_var(:)%i_ew=td_mpp%i_ew
210               ENDWHERE
211            ENDDO
212         ENDIF
213
214         IF( PRESENT(id_perio) )THEN
215            td_mpp%i_perio=id_perio
216         ENDIF
217
218      ENDIF
219
220   END SUBROUTINE iom_mpp_open
221   !-------------------------------------------------------------------
222   !> @brief This subroutine create files, composing mpp structure to be used,
223   !> in write mode.
224   !>
225   !> @author J.Paul
226   !> @date November, 2013 - Initial Version
227   !
228   !> @param[inout] td_mpp mpp structure
229   !-------------------------------------------------------------------
230   SUBROUTINE iom_mpp_create(td_mpp)
231      IMPLICIT NONE
232      ! Argument     
233      TYPE(TMPP), INTENT(INOUT)  :: td_mpp
234      !----------------------------------------------------------------
235      ! check if mpp exist
236      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
237
238         CALL logger_error( " IOM MPP CREATE: domain decomposition not define "//&
239         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
240
241      ELSE
242         ! forced to open in write mode
243         td_mpp%t_proc(:)%l_wrt=.TRUE.
244         td_mpp%t_proc(:)%l_use=.TRUE.
245         CALL iom_mpp_open(td_mpp)
246      ENDIF
247
248   END SUBROUTINE iom_mpp_create
249   !-------------------------------------------------------------------
250   !> @brief This subroutine close files composing mpp structure.
251   !>
252   !> @author J.Paul
253   !> @date November, 2013 - Initial Version
254   !
255   !> @param[in] td_mpp mpp structure
256   !-------------------------------------------------------------------
257   SUBROUTINE iom_mpp_close(td_mpp)
258      IMPLICIT NONE
259      ! Argument     
260      TYPE(TMPP), INTENT(INOUT) :: td_mpp
261
262      ! loop indices
263      INTEGER(i4) :: ji
264      !----------------------------------------------------------------
265      ! check if mpp exist
266      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
267
268         CALL logger_error( " IOM MPP CLOSE: domain decomposition not define "//&
269         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
270
271      ELSE
272         !
273         td_mpp%i_id=0         
274
275         DO ji=1,td_mpp%i_nproc
276            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
277               CALL iom_close(td_mpp%t_proc(ji))
278            ENDIF
279         ENDDO
280         td_mpp%t_proc(:)%l_use=.FALSE.
281      ENDIF
282
283   END SUBROUTINE iom_mpp_close
284   !-------------------------------------------------------------------
285   !> @brief This function read variable value in opened mpp files,
286   !> given variable id.
287   !>
288   !> @details
289   !> Optionally start indices and number of point to be read could be specify.
290   !> as well as East West ovelap of the global domain.
291   !>
292   !> @author J.Paul
293   !> @date November, 2013 - Initial Version
294   !> @date October, 2014
295   !> - use start and count array instead of domain structure.
296   !>
297   !> @param[in] td_mpp    mpp structure
298   !> @param[in] id_varid  variable id
299   !> @param[in] id_start  index in the variable from which the data values
300   !> will be read
301   !> @param[in] id_count  number of indices selected along each dimension
302   !> @return  variable structure
303   !-------------------------------------------------------------------
304   TYPE(TVAR) FUNCTION iom_mpp__read_var_id(td_mpp, id_varid,&
305   &                                        id_start, id_count)
306      IMPLICIT NONE
307      ! Argument     
308      TYPE(TMPP),                INTENT(IN) :: td_mpp
309      INTEGER(i4),               INTENT(IN) :: id_varid
310      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
311      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count     
312
313      ! local variable
314      INTEGER(i4), DIMENSION(1) :: il_ind
315      !----------------------------------------------------------------
316      ! check if mpp exist
317      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
318
319         CALL logger_error( " IOM MPP READ VAR: domain decomposition not define "//&
320         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
321
322      ELSEIF( td_mpp%i_id == 0 )THEN
323
324         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//&
325         &               " can not read variable in "//TRIM(td_mpp%c_name))   
326     
327      ELSE
328
329
330         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN
331            ! look for variable id
332            il_ind(:)=MINLOC( td_mpp%t_proc(1)%t_var(:)%i_id, &
333            &           mask=(td_mpp%t_proc(1)%t_var(:)%i_id==id_varid))
334            IF( il_ind(1) /= 0 )THEN
335
336               iom_mpp__read_var_id=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1)))
337
338               !!! read variable value
339               CALL iom_mpp__read_var_value(td_mpp, iom_mpp__read_var_id, &
340               &                            id_start, id_count)
341
342            ELSE
343               CALL logger_error( &
344               &  " IOM MPP READ VAR: there is no variable with id "//&
345               &  TRIM(fct_str(id_varid))//" in processor/file "//&
346               &  TRIM(td_mpp%t_proc(1)%c_name))
347            ENDIF
348         ELSE
349            CALL logger_error(" IOM MPP READ VAR: can't read variable, mpp "//&
350            &  TRIM(td_mpp%c_name)//" not opened")
351         ENDIF
352
353      ENDIF
354
355   END FUNCTION iom_mpp__read_var_id
356   !-------------------------------------------------------------------
357   !> @brief This function read variable value in opened mpp files,
358   !> given variable name or standard name.
359   !>
360   !> @details
361   !> Optionally start indices and number of point to be read could be specify.
362   !> as well as East West ovelap of the global domain.
363   !>
364   !> look first for variable name. If it doesn't
365   !> exist in file, look for variable standard name.<br/>
366   !> If variable name is not present, check variable standard name.<br/>
367   !
368   !> @author J.Paul
369   !> @date November, 2013 - Initial Version
370   !> @date October, 2014
371   !> - use start and count array instead of domain structure.
372   !
373   !> @param[in] td_mpp    mpp structure
374   !> @param[in] cd_name   variable name
375   !> @param[in] id_start  index in the variable from which the data values
376   !> will be read
377   !> @param[in] id_count  number of indices selected along each dimension
378   !> @return  variable structure
379   !-------------------------------------------------------------------
380   TYPE(TVAR) FUNCTION iom_mpp__read_var_name(td_mpp, cd_name,    &
381   &                                          id_start, id_count )
382      IMPLICIT NONE
383      ! Argument     
384      TYPE(TMPP),                INTENT(IN) :: td_mpp
385      CHARACTER(LEN=*),          INTENT(IN) :: cd_name
386      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
387      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count     
388
389      ! local variable
390      INTEGER(i4)       :: il_ind
391      !----------------------------------------------------------------
392      ! check if mpp exist
393      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
394
395         CALL logger_error( " IOM MPP READ VAR: domain decomposition not define "//&
396         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
397
398      ELSEIF( td_mpp%i_id == 0 )THEN
399
400         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//&
401         &               " can not read variable in "//TRIM(td_mpp%c_name))   
402     
403      ELSE
404
405            il_ind=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name)
406            IF( il_ind /= 0 )THEN
407
408               iom_mpp__read_var_name=var_copy(td_mpp%t_proc(1)%t_var(il_ind))
409
410               !!! read variable value
411               CALL iom_mpp__read_var_value( td_mpp, &
412               &                             iom_mpp__read_var_name, &
413               &                             id_start, id_count)
414
415            ELSE
416
417               CALL logger_error( &
418               &  " IOM MPP READ VAR: there is no variable with "//&
419               &  "name or standard name "//TRIM(cd_name)//&
420               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name))
421            ENDIF
422
423      ENDIF
424     
425   END FUNCTION iom_mpp__read_var_name
426   !-------------------------------------------------------------------
427   !> @brief This subroutine read variable value
428   !> in an mpp structure.
429   !>
430   !> @details
431   !> Optionally start indices and number of point to be read could be specify.
432   !> as well as East West ovelap of the global domain.
433   !
434   !> @author J.Paul
435   !> @date November, 2013 - Initial Version
436   !> @date October, 2014
437   !> - use start and count array instead of domain structure.
438   !>
439   !> @param[in] td_mpp    mpp structure
440   !> @param[inout] td_var variable structure
441   !> @param[in] id_start  index in the variable from which the data values
442   !> will be read
443   !> @param[in] id_count  number of indices selected along each dimension
444   !-------------------------------------------------------------------
445   SUBROUTINE iom_mpp__read_var_value(td_mpp, td_var, &
446   &                                  id_start, id_count )
447      IMPLICIT NONE
448      ! Argument     
449      TYPE(TMPP),   INTENT(IN)    :: td_mpp
450      TYPE(TVAR),   INTENT(INOUT) :: td_var
451      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_start
452      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_count     
453
454      ! local variable
455      INTEGER(i4)                       :: il_status
456      INTEGER(i4), DIMENSION(4)         :: il_ind
457      INTEGER(i4)                       :: il_i1p
458      INTEGER(i4)                       :: il_i2p
459      INTEGER(i4)                       :: il_j1p
460      INTEGER(i4)                       :: il_j2p
461      INTEGER(i4)                       :: il_i1
462      INTEGER(i4)                       :: il_i2
463      INTEGER(i4)                       :: il_j1
464      INTEGER(i4)                       :: il_j2
465
466      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
467      INTEGER(i4), DIMENSION(ip_maxdim) :: il_end
468      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count     
469
470      INTEGER(i4), DIMENSION(ip_maxdim) :: il_strt
471      INTEGER(i4), DIMENSION(ip_maxdim) :: il_cnt     
472
473      TYPE(TATT)                        :: tl_att
474      TYPE(TVAR)                        :: tl_var
475
476      ! loop indices
477      INTEGER(i4) :: jk
478      !----------------------------------------------------------------
479
480      il_start(:)=1
481      IF( PRESENT(id_start) ) il_start(:)=id_start(:)
482
483      il_count(:)=td_mpp%t_dim(:)%i_len
484      IF( PRESENT(id_count) ) il_count(:)=id_count(:)
485
486      CALL logger_debug("IOM MPP READ VAR VALUE: start "//&
487               &  TRIM(fct_str(il_start(jp_I)))//","//&
488               &  TRIM(fct_str(il_start(jp_J)))//","//&
489               &  TRIM(fct_str(il_start(jp_K)))//","//&
490               &  TRIM(fct_str(il_start(jp_L))) )
491      CALL logger_debug("IOM MPP READ VAR VALUE: count "//&
492               &  TRIM(fct_str(il_count(jp_I)))//","//&
493               &  TRIM(fct_str(il_count(jp_J)))//","//&
494               &  TRIM(fct_str(il_count(jp_K)))//","//&
495               &  TRIM(fct_str(il_count(jp_L))) )
496
497      DO jk=1,ip_maxdim
498         IF( .NOT. td_var%t_dim(jk)%l_use )THEN
499            il_start(jk) = 1
500            il_count(jk) = 1
501         ENDIF
502
503         il_end(jk)=il_start(jk)+il_count(jk)-1
504      ENDDO
505
506      IF( ANY(il_end(:) > td_mpp%t_dim(:)%i_len) )THEN
507            CALL logger_debug("IOM MPP READ VAR VALUE: start + count "//&
508               &  TRIM(fct_str(il_end(jp_I)))//","//&
509               &  TRIM(fct_str(il_end(jp_J)))//","//&
510               &  TRIM(fct_str(il_end(jp_K)))//","//&
511               &  TRIM(fct_str(il_end(jp_L))) )
512            CALL logger_debug("IOM MPP READ VAR VALUE: dimension "//&
513               &  TRIM(fct_str(td_mpp%t_dim(jp_I)%i_len))//","//&
514               &  TRIM(fct_str(td_mpp%t_dim(jp_J)%i_len))//","//&
515               &  TRIM(fct_str(td_mpp%t_dim(jp_K)%i_len))//","//&
516               &  TRIM(fct_str(td_mpp%t_dim(jp_L)%i_len)) )
517            CALL logger_fatal("IOM MPP READ VAR VALUE: start + count "//&
518            &                 "exceed dimension bound.")
519      ENDIF
520
521      ! use domain dimension
522      td_var%t_dim(:)%i_len=il_count(:)
523
524      ! Allocate space to hold variable value in structure
525      IF( ASSOCIATED(td_var%d_value) )THEN
526         DEALLOCATE(td_var%d_value)   
527      ENDIF
528
529      ALLOCATE(td_var%d_value( il_count(1), &
530      &                        il_count(2), &
531      &                        il_count(3), &
532      &                        il_count(4)),&
533      &        stat=il_status)
534      IF(il_status /= 0 )THEN
535
536        CALL logger_error( &
537         &  " IOM MPP READ VAR VALUE: not enough space to put variable "//&
538         &  TRIM(td_var%c_name)//&
539         &  " in variable structure")
540
541      ENDIF
542
543      CALL logger_debug("IOM MPP READ VAR VALUE: shape ("//&
544      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=1)))//","//&
545      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=2)))//","//&
546      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=3)))//","//&
547      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=4)))//")" )
548      ! FillValue by default
549      td_var%d_value(:,:,:,:)=td_var%d_fill
550
551      ! read processor
552      DO jk=1,td_mpp%i_nproc
553         IF( td_mpp%t_proc(jk)%l_use )THEN
554             
555            ! get processor indices
556            il_ind(:)=mpp_get_proc_index( td_mpp, jk )
557            il_i1p = il_ind(1)
558            il_i2p = il_ind(2)
559            il_j1p = il_ind(3)
560            il_j2p = il_ind(4)
561 
562            IF( .NOT. td_var%t_dim(1)%l_use )THEN
563               il_i1p=il_start(1) ; il_i2p=il_end(1)
564            ENDIF
565            IF( .NOT. td_var%t_dim(2)%l_use )THEN
566               il_j1p=il_start(2) ; il_j2p=il_end(2)
567            ENDIF           
568           
569            il_i1=MAX(il_i1p, il_start(1))
570            il_i2=MIN(il_i2p, il_end(1))
571
572            il_j1=MAX(il_j1p, il_start(2))
573            il_j2=MIN(il_j2p, il_end(2))
574
575            IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN
576               il_strt(:)=(/ il_i1-il_i1p+1, &
577               &             il_j1-il_j1p+1, &
578               &             1,1 /)
579
580               il_cnt(:)=(/ il_i2-il_i1+1,         &
581               &            il_j2-il_j1+1,         &
582               &            td_var%t_dim(3)%i_len, &
583               &            td_var%t_dim(4)%i_len /)
584
585               tl_var=iom_read_var( td_mpp%t_proc(jk), td_var%c_name,&
586               &                    il_strt(:), il_cnt(:) )
587               ! replace value in output variable structure
588               td_var%d_value( il_i1 - il_start(1) + 1 : &
589               &               il_i2 - il_start(1) + 1,  &
590               &               il_j1 - il_start(2) + 1 : &
591               &               il_j2 - il_start(2) + 1,  &
592               &               :,:) = tl_var%d_value(:,:,:,:)
593
594               ! clean
595               CALL var_clean(tl_var)
596            ENDIF
597
598         ENDIF
599      ENDDO
600
601      IF( td_var%t_dim(1)%l_use .AND. &
602      &   td_var%t_dim(1)%i_len == td_mpp%t_dim(1)%i_len )THEN
603         IF( td_mpp%i_ew >= 0 )THEN
604            tl_att=att_init("ew_overlap",td_mpp%i_ew)
605            CALL var_move_att(td_var,tl_att)
606            ! clean
607            CALL att_clean(tl_att)
608         ENDIF
609      ENDIF
610
611      ! force to change _FillValue to avoid mistake
612      ! with dummy zero _FillValue
613      IF( td_var%d_fill == 0._dp )THEN
614         CALL var_chg_FillValue(td_var)
615      ENDIF     
616
617   END SUBROUTINE iom_mpp__read_var_value
618   !-------------------------------------------------------------------
619   !> @brief This subroutine write files composing mpp structure.
620   !
621   !> @details
622   !> optionally, you could specify the dimension order (default 'xyzt')
623   !
624   !> @author J.Paul
625   !> @date November, 2013 - Initial Version
626   !> @date July, 2015 - add dimension order option
627   !
628   !> @param[inout] td_mpp mpp structure
629   !> @param[In] cd_dimorder dimension order
630   !-------------------------------------------------------------------
631   SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder)
632      IMPLICIT NONE
633      ! Argument     
634      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
635      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
636
637      ! local variable
638      ! loop indices
639      INTEGER(i4) :: ji
640      !----------------------------------------------------------------
641      ! check if mpp exist
642      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
643
644         CALL logger_error( " MPP WRITE: domain decomposition not define "//&
645         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
646
647      ELSE
648         DO ji=1, td_mpp%i_nproc
649            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
650               !CALL file_del_att(td_mpp%t_proc(ji), 'periodicity')
651               !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap')
652
653               CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder)
654            ELSE
655               CALL logger_debug( " MPP WRITE: no id associated to file "//&
656               &              TRIM(td_mpp%t_proc(ji)%c_name) )
657            ENDIF
658         ENDDO
659      ENDIF
660   END SUBROUTINE iom_mpp_write_file
661END MODULE iom_mpp
Note: See TracBrowser for help on using the repository browser.