source: branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90 @ 5600

Last change on this file since 5600 was 5600, checked in by andrewryan, 5 years ago

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File size: 22.2 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 Nov, 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   !> - 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         ! 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')
182                     cl_name=TRIM( file_rename(td_mpp%c_name, ji) )
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
215      ENDIF
216
217   END SUBROUTINE iom_mpp_open
218   !-------------------------------------------------------------------
219   !> @brief This subroutine create files, composing mpp structure to be used,
220   !> in write mode.
221   !>
222   !> @author J.Paul
223   !> - November, 2013- Initial Version
224   !
225   !> @param[inout] td_mpp mpp structure
226   !-------------------------------------------------------------------
227   SUBROUTINE iom_mpp_create(td_mpp)
228      IMPLICIT NONE
229      ! Argument     
230      TYPE(TMPP), INTENT(INOUT)  :: td_mpp
231      !----------------------------------------------------------------
232      ! check if mpp exist
233      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
234
235         CALL logger_error( " IOM MPP CREATE: domain decomposition not define "//&
236         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
237
238      ELSE
239         ! forced to open in write mode
240         td_mpp%t_proc(:)%l_wrt=.TRUE.
241         td_mpp%t_proc(:)%l_use=.TRUE.
242         CALL iom_mpp_open(td_mpp)
243      ENDIF
244
245   END SUBROUTINE iom_mpp_create
246   !-------------------------------------------------------------------
247   !> @brief This subroutine close files composing mpp structure.
248   !>
249   !> @author J.Paul
250   !> - November, 2013- Initial Version
251   !
252   !> @param[in] td_mpp mpp structure
253   !-------------------------------------------------------------------
254   SUBROUTINE iom_mpp_close(td_mpp)
255      IMPLICIT NONE
256      ! Argument     
257      TYPE(TMPP), INTENT(INOUT) :: td_mpp
258
259      ! loop indices
260      INTEGER(i4) :: ji
261      !----------------------------------------------------------------
262      ! check if mpp exist
263      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
264
265         CALL logger_error( " IOM MPP CLOSE: domain decomposition not define "//&
266         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
267
268      ELSE
269         DO ji=1,td_mpp%i_nproc
270            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
271               CALL iom_close(td_mpp%t_proc(ji))
272            ENDIF
273         ENDDO
274         td_mpp%t_proc(:)%l_use=.FALSE.
275      ENDIF
276
277   END SUBROUTINE iom_mpp_close
278   !-------------------------------------------------------------------
279   !> @brief This function read variable value in opened mpp files,
280   !> given variable id.
281   !>
282   !> @details
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   !>
286   !> @author J.Paul
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
296   !> @return  variable structure
297   !-------------------------------------------------------------------
298   TYPE(TVAR) FUNCTION iom_mpp__read_var_id(td_mpp, id_varid,&
299   &                                        id_start, id_count)
300      IMPLICIT NONE
301      ! Argument     
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     
306
307      ! local variable
308      INTEGER(i4), DIMENSION(1) :: il_ind
309      !----------------------------------------------------------------
310      ! check if mpp exist
311      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
312
313         CALL logger_error( " IOM MPP READ VAR: domain decomposition not define "//&
314         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
315
316      ELSE
317
318         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN
319            ! look for variable id
320            il_ind(:)=MINLOC( td_mpp%t_proc(1)%t_var(:)%i_id, &
321            &           mask=(td_mpp%t_proc(1)%t_var(:)%i_id==id_varid))
322            IF( il_ind(1) /= 0 )THEN
323
324               iom_mpp__read_var_id=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1)))
325
326               !!! read variable value
327               CALL iom_mpp__read_var_value(td_mpp, iom_mpp__read_var_id, &
328               &                            id_start, id_count)
329
330            ELSE
331               CALL logger_error( &
332               &  " IOM MPP READ VAR: there is no variable with id "//&
333               &  TRIM(fct_str(id_varid))//" in processor/file "//&
334               &  TRIM(td_mpp%t_proc(1)%c_name))
335            ENDIF
336         ELSE
337            CALL logger_error(" IOM MPP READ VAR: can't read variable, mpp "//&
338            &  TRIM(td_mpp%c_name)//" not opened")
339         ENDIF
340
341      ENDIF
342
343   END FUNCTION iom_mpp__read_var_id
344   !-------------------------------------------------------------------
345   !> @brief This function read variable value in opened mpp files,
346   !> given variable name or standard name.
347   !>
348   !> @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   !>
352   !> look first for variable name. If it doesn't
353   !> exist in file, look for variable standard name.<br/>
354   !> If variable name is not present, check variable standard name.<br/>
355   !
356   !> @author J.Paul
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
366   !> @return  variable structure
367   !-------------------------------------------------------------------
368   TYPE(TVAR) FUNCTION iom_mpp__read_var_name(td_mpp, cd_name,    &
369   &                                          id_start, id_count )
370      IMPLICIT NONE
371      ! Argument     
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     
376
377      ! local variable
378      INTEGER(i4)       :: il_ind
379      !----------------------------------------------------------------
380      ! check if mpp exist
381      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
382
383         CALL logger_error( " IOM MPP READ VAR: domain decomposition not define "//&
384         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
385
386      ELSE
387
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))
392
393               !!! read variable value
394               CALL iom_mpp__read_var_value( td_mpp, &
395               &                             iom_mpp__read_var_name, &
396               &                             id_start, id_count)
397
398            ELSE
399
400               CALL logger_error( &
401               &  " IOM MPP READ VAR: there is no variable with "//&
402               &  "name or standard name"//TRIM(cd_name)//&
403               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name))
404            ENDIF
405
406      ENDIF
407     
408   END FUNCTION iom_mpp__read_var_name
409   !-------------------------------------------------------------------
410   !> @brief This subroutine read variable value
411   !> in an mpp structure.
412   !>
413   !> @details
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.
416   !
417   !> @author J.Paul
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   !-------------------------------------------------------------------
428   SUBROUTINE iom_mpp__read_var_value(td_mpp, td_var, &
429   &                                  id_start, id_count )
430      IMPLICIT NONE
431      ! Argument     
432      TYPE(TMPP),   INTENT(IN)    :: td_mpp
433      TYPE(TVAR),   INTENT(INOUT) :: td_var
434      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_start
435      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_count     
436
437      ! local variable
438      INTEGER(i4)                       :: il_status
439      INTEGER(i4), DIMENSION(4)         :: il_ind
440      INTEGER(i4)                       :: il_i1p
441      INTEGER(i4)                       :: il_i2p
442      INTEGER(i4)                       :: il_j1p
443      INTEGER(i4)                       :: il_j2p
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
457      TYPE(TVAR)                        :: tl_var
458
459      ! loop indices
460      INTEGER(i4) :: jk
461      !----------------------------------------------------------------
462
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
476      ENDDO
477
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
513
514      ! read processor
515      DO jk=1,td_mpp%i_nproc
516         IF( td_mpp%t_proc(jk)%l_use )THEN
517             
518            ! get processor indices
519            il_ind(:)=mpp_get_proc_index( td_mpp, jk )
520            il_i1p = il_ind(1)
521            il_i2p = il_ind(2)
522            il_j1p = il_ind(3)
523            il_j2p = il_ind(4)
524 
525            IF( .NOT. td_var%t_dim(1)%l_use )THEN
526               il_i1p=il_start(1) ; il_i2p=il_end(1)
527            ENDIF
528            IF( .NOT. td_var%t_dim(2)%l_use )THEN
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)
559            ENDIF
560
561         ENDIF
562      ENDDO
563
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   !
584   !> @details
585   !
586   !> @author J.Paul
587   !> - November, 2013- Initial Version
588   !
589   !> @param[inout] td_mpp mpp structure
590   !-------------------------------------------------------------------
591   SUBROUTINE iom_mpp_write_file(td_mpp)
592      IMPLICIT NONE
593      ! Argument     
594      TYPE(TMPP), INTENT(INOUT) :: td_mpp
595
596      ! local variable
597      ! loop indices
598      INTEGER(i4) :: ji
599      !----------------------------------------------------------------
600      ! check if mpp exist
601      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
602
603         CALL logger_error( " MPP WRITE: domain decomposition not define "//&
604         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
605
606      ELSE
607         DO ji=1, td_mpp%i_nproc
608            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
612               CALL iom_write_file(td_mpp%t_proc(ji))
613            ELSE
614               CALL logger_debug( " MPP WRITE: no id associated to file "//&
615               &              TRIM(td_mpp%t_proc(ji)%c_name) )
616            ENDIF
617         ENDDO
618      ENDIF
619   END SUBROUTINE iom_mpp_write_file
620END MODULE iom_mpp
Note: See TracBrowser for help on using the repository browser.