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/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/TOOLS/SIREN/src – NEMO

Context Navigation

source: branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90 @ 5967

Last change on this file since 5967 was 5967, checked in by timgraham, 8 years ago
Reset keywords before merging with head of trunk
Property svn:keywords set to `Id`
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	!----------------------------------------------------------------------
93	MODULE 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
124	CONTAINS
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
620	END MODULE iom_mpp

Note: See TracBrowser for help on using the repository browser.

Download in other formats: