Context Navigation

source: codes/icosagcm/trunk/src/write_field.f90 @ 78

Last change on this file since 78 was 77, checked in by ymipsl, 12 years ago

changing 'Z' dimension into 'lev' in writefield

YM

File size: 61.6 KB

Line
1	module write_field
2	USE genmod
3	implicit none
4
5	TYPE ncvar
6	INTEGER :: size
7	INTEGER,POINTER :: nc_id(:)
8	INTEGER :: displ
9	END TYPE ncvar
10
11	integer, parameter :: MaxWriteField = 1000
12	integer, dimension(MaxWriteField),save :: FieldId
13	TYPE(ncvar), dimension(MaxWriteField),save :: FieldVarId
14	integer, dimension(MaxWriteField),save :: FieldIndex
15	character(len=255), dimension(MaxWriteField) :: FieldName
16
17	integer,save :: NbField = 0
18
19	contains
20
21	function GetFieldIndex(name)
22	implicit none
23	integer :: GetFieldindex
24	character(len=*) :: name
25
26	character(len=255) :: TrueName
27	integer :: i
28
29
30	TrueName=TRIM(ADJUSTL(name))
31
32	GetFieldIndex=-1
33	do i=1,NbField
34	if (TrueName==FieldName(i)) then
35	GetFieldIndex=i
36	exit
37	endif
38	enddo
39	end function GetFieldIndex
40
41	SUBROUTINE Writefield(name_in,field,nind)
42	USE domain_mod
43	USE field_mod
44	USE transfert_mpi_mod
45	USE dimensions
46	USE mpipara
47	IMPLICIT NONE
48	CHARACTER(LEN=*),INTENT(IN) :: name_in
49	TYPE(t_field),POINTER :: field(:)
50	INTEGER,OPTIONAL,INTENT(IN) :: nind
51	TYPE(t_field),POINTER :: field_glo(:)
52
53	IF (field(1)%ndim==2) THEN
54	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type)
55	ELSE IF (field(1)%ndim==3) THEN
56	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3)
57	ELSE IF (field(1)%ndim==4) THEN
58	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4)
59	ENDIF
60
61	CALL gather_field(field,field_glo)
62
63	IF (mpi_rank==0) THEN
64	IF (PRESENT(nind)) THEN
65	CALL writefield_gen(name_in,field_glo,domain_glo,nind)
66	ELSE
67	CALL writefield_gen(name_in,field_glo,domain_glo,1,ndomain_glo)
68	ENDIF
69	ENDIF
70
71	CALL deallocate_field(field_glo)
72
73	END SUBROUTINE writefield
74
75	! SUBROUTINE Writefield(name_in,field,nind)
76	! USE netcdf
77	! USE domain_mod
78	! use field_mod
79	! USE dimensions
80	! USE geometry
81	! IMPLICIT NONE
82	! CHARACTER(LEN=*),INTENT(IN) :: name_in
83	! TYPE(t_field),POINTER :: field(:)
84	! INTEGER,OPTIONAL,INTENT(IN) :: nind
85	! REAL(r8),ALLOCATABLE :: field_val2d(:)
86	! REAL(r8),ALLOCATABLE :: field_val3d(:,:)
87	! REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)
88	! TYPE(t_domain),POINTER :: d
89	! INTEGER :: Index
90	! INTEGER :: ind,i,j,k,n,ncell,q
91	! INTEGER :: iie,jje,iin,jjn
92	! INTEGER :: status
93	! CHARACTER(len=255) :: name
94	! CHARACTER(len=255) :: str_ind
95	! INTEGER :: ind_b,ind_e
96	! INTEGER :: halo_size
97	! LOGICAL :: single
98	!
99	!
100	! name=TRIM(ADJUSTL(name_in))
101
102	! IF (PRESENT(nind)) THEN
103	! name=TRIM(name)//"_"//TRIM(int2str(nind))
104	! PRINT *,"NAME",nind,int2str(nind),name
105	! ind_b=nind
106	! ind_e=nind
107	! halo_size=1
108	! single=.TRUE.
109	! ELSE
110	! ind_b=1
111	! ind_e=ndomain
112	! halo_size=0
113	! single=.FALSE.
114	! ENDIF
115
116	! Index=GetFieldIndex(name)
117	! if (Index==-1) then
118	! call create_header(name,field,nind)
119	! Index=GetFieldIndex(name)
120	! else
121	! FieldIndex(Index)=FieldIndex(Index)+1.
122	! endif
123	!
124	! IF (Field(ind_b)%field_type==field_T) THEN
125	! ncell=1
126	! DO ind=ind_b,ind_e
127	! d=>domain(ind)
128	! IF (Field(ind)%field_type/=field_T) THEN
129	! PRINT *,"Writefield, grille non geree"
130	! RETURN
131	! ENDIF
132
133	! n=0
134	! DO j=d%jj_begin-halo_size,d%jj_end+halo_size
135	! DO i=d%ii_begin-halo_size,d%ii_end+halo_size
136	! IF (d%own(i,j) .OR. single) n=n+1
137	! ENDDO
138	! ENDDO
139
140	! IF (field(ind)%ndim==2) THEN
141	! ALLOCATE(Field_val2d(n))
142	! n=0
143	! DO j=d%jj_begin-halo_size,d%jj_end+halo_size
144	! DO i=d%ii_begin-halo_size,d%ii_end+halo_size
145	! k=d%iim*(j-1)+i
146	! IF (d%own(i,j) .OR. single) THEN
147	! n=n+1
148	! Field_val2d(n)=field(ind)%rval2d(k)
149	! ENDIF
150	! ENDDO
151	! ENDDO
152	! status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d, &
153	! start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /))
154	! DEALLOCATE(field_val2d)
155	! ELSE IF (field(ind)%ndim==3) THEN
156	! ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
157	! n=0
158	! DO j=d%jj_begin-halo_size,d%jj_end+halo_size
159	! DO i=d%ii_begin-halo_size,d%ii_end+halo_size
160	! k=d%iim*(j-1)+i
161	! IF (d%own(i,j) .OR. single) THEN
162	! n=n+1
163	! Field_val3d(n,:)=field(ind)%rval3d(k,:)
164	! ENDIF
165	! ENDDO
166	! ENDDO
167	! status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /), &
168	! count=(/n,size(field(1)%rval3d,2),1 /))
169	! DEALLOCATE(field_val3d)
170	! ELSE IF (field(1)%ndim==4) THEN
171
172	! DO q=1,FieldVarId(index)%size
173	!
174	! ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
175	! n=0
176	! DO j=d%jj_begin-halo_size,d%jj_end+halo_size
177	! DO i=d%ii_begin-halo_size,d%ii_end+halo_size
178	! k=d%iim*(j-1)+i
179	! IF (d%own(i,j) .OR. single) THEN
180	! n=n+1
181	! Field_val3d(n,:)=field(ind)%rval4d(k,:,q)
182	! ENDIF
183	! ENDDO
184	! ENDDO
185	! status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /), &
186	! count=(/n,size(field(1)%rval4d,2),1 /))
187	! DEALLOCATE(field_val3d)
188	! ENDDO
189	! ENDIF
190	!
191	! PRINT *,NF90_STRERROR(status)
192	! ncell=ncell+n
193
194	! ENDDO
195	!
196	! ELSE IF (Field(ind_b)%field_type==field_Z) THEN
197	! ncell=1
198	! n=0
199	! DO ind=ind_b,ind_e
200	! d=>domain(ind)
201	! CALL swap_geometry(ind)
202	! CALL swap_dimensions(ind)
203	!
204	! n=0
205	! DO j=jj_begin+1,jj_end
206	! DO i=ii_begin,ii_end-1
207	! n=n+1
208	! ENDDO
209	! ENDDO
210
211	! DO j=jj_begin,jj_end-1
212	! DO i=ii_begin+1,ii_end
213	! n=n+1
214	! ENDDO
215	! ENDDO
216
217	! IF (field(ind)%ndim==2) THEN
218	! ALLOCATE(Field_val2d(n))
219
220	! n=0
221	! DO j=jj_begin+1,jj_end
222	! DO i=ii_begin,ii_end-1
223	! n=n+1
224	! k=iim*(j-1)+i
225	! Field_val2d(n)=field(ind)%rval2d(k+z_down)
226	! ENDDO
227	! ENDDO
228
229	! DO j=jj_begin,jj_end-1
230	! DO i=ii_begin+1,ii_end
231	! n=n+1
232	! k=iim*(j-1)+i
233	! Field_val2d(n)=field(ind)%rval2d(k+z_up)
234	! ENDDO
235	! ENDDO
236
237	! status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1), &
238	! Field_val2d,start=(/ ncell,FieldIndex(Index) /),count=(/n,1 /))
239	! DEALLOCATE(field_val2d)
240
241	! ELSE IF (field(ind)%ndim==3) THEN
242	! ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
243	! n=0
244	! DO j=jj_begin+1,jj_end
245	! DO i=ii_begin,ii_end-1
246	! n=n+1
247	! k=iim*(j-1)+i
248	! Field_val3d(n,:)=field(ind)%rval3d(k+z_down,:)
249	! ENDDO
250	! ENDDO
251
252	! DO j=jj_begin,jj_end-1
253	! DO i=ii_begin+1,ii_end
254	! n=n+1
255	! k=iim*(j-1)+i
256	! Field_val3d(n,:)=field(ind)%rval3d(k+z_up,:)
257	! ENDDO
258	! ENDDO
259	! status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ ncell,1,FieldIndex(Index) /), &
260	! count=(/n,size(field(1)%rval3d,2),1 /))
261	! DEALLOCATE(field_val3d)
262	! ELSE IF (field(1)%ndim==4) THEN
263
264	! DO q=1,FieldVarId(index)%size
265	! ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
266	! n=0
267	! DO j=jj_begin+1,jj_end
268	! DO i=ii_begin,ii_end-1
269	! n=n+1
270	! k=iim*(j-1)+i
271	! Field_val3d(n,:)=field(ind)%rval4d(k+z_down,:,q)
272	! ENDDO
273	! ENDDO
274
275	! DO j=jj_begin,jj_end-1
276	! DO i=ii_begin+1,ii_end
277	! n=n+1
278	! k=iim*(j-1)+i
279	! Field_val3d(n,:)=field(ind)%rval4d(k+z_up,:,q)
280	! ENDDO
281	! ENDDO
282
283	! status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ ncell,1,1,FieldIndex(Index) /), &
284	! count=(/n,size(field(1)%rval4d,2),1 /))
285	! DEALLOCATE(field_val3d)
286	! ENDDO
287	! ENDIF
288	!
289	! PRINT *,NF90_STRERROR(status)
290	! ncell=ncell+n
291
292	! ENDDO
293	!
294	! ENDIF
295	! status=NF90_SYNC(FieldId(Index))
296	!
297	! END SUBROUTINE Writefield
298
299
300	SUBROUTINE Writefield_gen(name_in, field, domain_type, ind_b_in, ind_e_in )
301	USE netcdf_mod
302	USE domain_mod
303	USE field_mod
304	! USE dimensions
305	! USE geometry
306	IMPLICIT NONE
307	CHARACTER(LEN=*),INTENT(IN) :: name_in
308	TYPE(t_field), POINTER :: field(:)
309	TYPE(t_domain),INTENT(IN),TARGET :: domain_type(:)
310	INTEGER,OPTIONAL,INTENT(IN) :: ind_b_in
311	INTEGER,OPTIONAL,INTENT(IN) :: ind_e_in
312	REAL(r8),ALLOCATABLE :: field_val2d(:)
313	REAL(r8),ALLOCATABLE :: field_val3d(:,:)
314	REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)
315	TYPE(t_domain),POINTER :: d
316	INTEGER :: Index
317	INTEGER :: ind,i,j,k,n,ncell,q
318	INTEGER :: iie,jje,iin,jjn
319	INTEGER :: status
320	CHARACTER(len=255) :: name
321	CHARACTER(len=255) :: str_ind
322	INTEGER :: ind_b,ind_e
323	INTEGER :: halo_size
324	LOGICAL :: single
325
326
327	name=TRIM(ADJUSTL(name_in))
328
329	IF (PRESENT(ind_b_in) .AND. .NOT. PRESENT(ind_e_in)) THEN
330	name=TRIM(name)//"_"//TRIM(int2str(ind_b))
331	ind_b=ind_b_in
332	ind_e=ind_b_in
333	halo_size=1
334	single=.TRUE.
335	ELSE IF (.NOT. PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
336	name=TRIM(name)//"_"//TRIM(int2str(ind_e))
337	ind_b=ind_e_in
338	ind_e=ind_e_in
339	halo_size=1
340	single=.TRUE.
341	ELSE IF ( PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
342	ind_b=ind_b_in
343	ind_e=ind_e_in
344	halo_size=0
345	single=.FALSE.
346	ELSE
347	halo_size=0
348	ind_b=1
349	ind_e=ndomain
350	single=.FALSE.
351	ENDIF
352
353	Index=GetFieldIndex(name)
354	if (Index==-1) then
355	call create_header_gen(name_in,field,domain_type,ind_b_in,ind_e_in)
356	Index=GetFieldIndex(name)
357	else
358	FieldIndex(Index)=FieldIndex(Index)+1.
359	endif
360
361	IF (Field(ind_b)%field_type==field_T) THEN
362
363	ncell=0
364	DO ind=ind_b,ind_e
365	d=>domain_type(ind)
366	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
367	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
368	IF (d%assign_domain(i,j)==ind .OR. single) ncell=ncell+1
369	ENDDO
370	ENDDO
371	ENDDO
372
373	IF (field(1)%ndim==2) THEN
374	ALLOCATE(Field_val2d(ncell))
375	n=0
376	DO ind=ind_b,ind_e
377	d=>domain_type(ind)
378	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
379	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
380	k=d%iim*(j-1)+i
381	IF (d%assign_domain(i,j)==ind .OR. single) THEN
382	n=n+1
383	Field_val2d(n)=field(ind)%rval2d(k)
384	ENDIF
385	ENDDO
386	ENDDO
387	ENDDO
388	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d, &
389	start=(/ 1,FieldIndex(Index) /),count=(/ncell,1 /))
390	DEALLOCATE(field_val2d)
391	ELSE IF (field(1)%ndim==3) THEN
392	ALLOCATE(Field_val3d(ncell,size(field(1)%rval3d,2)))
393	n=0
394	DO ind=ind_b,ind_e
395	d=>domain_type(ind)
396	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
397	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
398	k=d%iim*(j-1)+i
399	IF (d%assign_domain(i,j)==ind .OR. single) THEN
400	n=n+1
401	Field_val3d(n,:)=field(ind)%rval3d(k,:)
402	ENDIF
403	ENDDO
404	ENDDO
405	ENDDO
406
407	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1,FieldIndex(Index) /), &
408	count=(/ncell,size(field(1)%rval3d,2),1 /))
409	DEALLOCATE(field_val3d)
410	ELSE IF (field(1)%ndim==4) THEN
411
412	DO q=1,FieldVarId(index)%size
413
414	ALLOCATE(Field_val3d(ncell,size(field(1)%rval4d,2)))
415	n=0
416	DO ind=ind_b,ind_e
417	d=>domain_type(ind)
418	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
419	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
420	k=d%iim*(j-1)+i
421	IF (d%assign_domain(i,j)==ind .OR. single) THEN
422	n=n+1
423	Field_val3d(n,:)=field(ind)%rval4d(k,:,q)
424	ENDIF
425	ENDDO
426	ENDDO
427	ENDDO
428
429	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1,FieldIndex(Index) /), &
430	count=(/ncell,size(field(1)%rval4d,2),1 /))
431	DEALLOCATE(field_val3d)
432	ENDDO
433	ENDIF
434
435	! PRINT *,NF90_STRERROR(status)
436	! ncell=ncell+n
437
438	! ENDDO
439
440	ELSE IF (Field(ind_b)%field_type==field_Z) THEN
441
442	ncell=0
443	DO ind=ind_b,ind_e
444	d=>domain_type(ind)
445
446	DO j=d%jj_begin+1,d%jj_end
447	DO i=d%ii_begin,d%ii_end-1
448	ncell=ncell+1
449	ENDDO
450	ENDDO
451
452	DO j=d%jj_begin,d%jj_end-1
453	DO i=d%ii_begin+1,d%ii_end
454	ncell=ncell+1
455	ENDDO
456	ENDDO
457	ENDDO
458
459	IF (field(1)%ndim==2) THEN
460	ALLOCATE(Field_val2d(ncell))
461
462	n=0
463
464	DO ind=ind_b,ind_e
465	d=>domain_type(ind)
466	DO j=d%jj_begin+1,d%jj_end
467	DO i=d%ii_begin,d%ii_end-1
468	n=n+1
469	k=d%iim*(j-1)+i
470	Field_val2d(n)=field(ind)%rval2d(k+d%z_down)
471	ENDDO
472	ENDDO
473
474	DO j=d%jj_begin,d%jj_end-1
475	DO i=d%ii_begin+1,d%ii_end
476	n=n+1
477	k=d%iim*(j-1)+i
478	Field_val2d(n)=field(ind)%rval2d(k+d%z_up)
479	ENDDO
480	ENDDO
481	ENDDO
482
483	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1), &
484	Field_val2d,start=(/ 1,FieldIndex(Index) /),count=(/ncell,1 /))
485	DEALLOCATE(field_val2d)
486
487	ELSE IF (field(1)%ndim==3) THEN
488	ALLOCATE(Field_val3d(ncell,size(field(1)%rval3d,2)))
489	n=0
490	DO ind=ind_b,ind_e
491	d=>domain_type(ind)
492	DO j=d%jj_begin+1,d%jj_end
493	DO i=d%ii_begin,d%ii_end-1
494	n=n+1
495	k=d%iim*(j-1)+i
496	Field_val3d(n,:)=field(ind)%rval3d(k+d%z_down,:)
497	ENDDO
498	ENDDO
499
500	DO j=d%jj_begin,d%jj_end-1
501	DO i=d%ii_begin+1,d%ii_end
502	n=n+1
503	k=d%iim*(j-1)+i
504	Field_val3d(n,:)=field(ind)%rval3d(k+d%z_up,:)
505	ENDDO
506	ENDDO
507	ENDDO
508
509	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d,start=(/ 1,1,FieldIndex(Index) /), &
510	count=(/ncell,size(field(1)%rval3d,2),1 /))
511	DEALLOCATE(field_val3d)
512
513	ELSE IF (field(1)%ndim==4) THEN
514
515	DO q=1,FieldVarId(index)%size
516	ALLOCATE(Field_val3d(ncell,size(field(1)%rval4d,2)))
517	n=0
518	DO ind=ind_b,ind_e
519	d=>domain_type(ind)
520	DO j=d%jj_begin+1,d%jj_end
521	DO i=d%ii_begin,d%ii_end-1
522	n=n+1
523	k=d%iim*(j-1)+i
524	Field_val3d(n,:)=field(ind)%rval4d(k+d%z_down,:,q)
525	ENDDO
526	ENDDO
527
528	DO j=d%jj_begin,d%jj_end-1
529	DO i=d%ii_begin+1,d%ii_end
530	n=n+1
531	k=d%iim*(j-1)+i
532	Field_val3d(n,:)=field(ind)%rval4d(k+d%z_up,:,q)
533	ENDDO
534	ENDDO
535	ENDDO
536
537	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d,start=(/ 1,1,1,FieldIndex(Index) /), &
538	count=(/ncell,size(field(1)%rval4d,2),1 /))
539	DEALLOCATE(field_val3d)
540	ENDDO
541	ENDIF
542
543	! PRINT *,NF90_STRERROR(status)
544	! ncell=ncell+n
545	!
546	! ENDDO
547
548	ENDIF
549	status=NF90_SYNC(FieldId(Index))
550
551	END SUBROUTINE Writefield_gen
552
553
554
555	SUBROUTINE Writefield_mpi(name_in,field,nind)
556	USE netcdf_mod
557	USE domain_mod
558	use field_mod
559	USE dimensions
560	USE geometry
561	IMPLICIT NONE
562	CHARACTER(LEN=*),INTENT(IN) :: name_in
563	TYPE(t_field),POINTER :: field(:)
564	INTEGER,OPTIONAL,INTENT(IN) :: nind
565	REAL(r8),ALLOCATABLE :: field_val2d(:)
566	REAL(r8),ALLOCATABLE :: field_val3d(:,:)
567	REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)
568	TYPE(t_domain),POINTER :: d
569	INTEGER :: Index
570	INTEGER :: ind,i,j,l,k,n,ncell,q
571	INTEGER :: iie,jje,iin,jjn
572	INTEGER :: status
573	CHARACTER(len=255) :: name
574	CHARACTER(len=255) :: str_ind
575	INTEGER :: ind_b,ind_e
576	INTEGER :: halo_size
577	LOGICAL :: single
578	INTEGER :: displ
579
580
581	name=TRIM(ADJUSTL(name_in))
582
583	IF (PRESENT(nind)) THEN
584	name=TRIM(name)//"_"//TRIM(int2str(nind))
585	PRINT *,"NAME",nind,int2str(nind),name
586	ind_b=nind
587	ind_e=nind
588	halo_size=1
589	single=.TRUE.
590	ELSE
591	ind_b=1
592	ind_e=ndomain
593	halo_size=0
594	single=.FALSE.
595	ENDIF
596
597	Index=GetFieldIndex(name)
598	if (Index==-1) then
599	call create_header_mpi(name,field,nind)
600	Index=GetFieldIndex(name)
601	else
602	FieldIndex(Index)=FieldIndex(Index)+1.
603	endif
604
605	IF (Field(ind_b)%field_type==field_T) THEN
606	ncell=1
607	DO ind=ind_b,ind_e
608	d=>domain(ind)
609	IF (Field(ind)%field_type/=field_T) THEN
610	PRINT *,"Writefield, grille non geree"
611	RETURN
612	ENDIF
613
614	n=0
615	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
616	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
617	IF (d%own(i,j) .OR. single) n=n+1
618	ENDDO
619	ENDDO
620
621	displ=FieldVarId(index)%displ
622
623	IF (field(ind)%ndim==2) THEN
624	ALLOCATE(Field_val2d(n))
625	n=0
626	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
627	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
628	k=d%iim*(j-1)+i
629	IF (d%own(i,j) .OR. single) THEN
630	n=n+1
631	Field_val2d(n)=field(ind)%rval2d(k)
632	ENDIF
633	ENDDO
634	ENDDO
635	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d, &
636	start=(/ displ+ncell,FieldIndex(Index) /),count=(/n,1 /))
637	DEALLOCATE(field_val2d)
638	ELSE IF (field(ind)%ndim==3) THEN
639	ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
640	n=0
641	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
642	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
643	k=d%iim*(j-1)+i
644	IF (d%own(i,j) .OR. single) THEN
645	n=n+1
646	Field_val3d(n,:)=field(ind)%rval3d(k,:)
647	ENDIF
648	ENDDO
649	ENDDO
650	! DO l=1,size(field(ind)%rval3d,2)
651	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d, &
652	start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval3d,2),1 /))
653	! ENDDO
654	DEALLOCATE(field_val3d)
655	ELSE IF (field(1)%ndim==4) THEN
656
657	DO q=1,FieldVarId(index)%size
658
659	ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
660	n=0
661	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
662	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
663	k=d%iim*(j-1)+i
664	IF (d%own(i,j) .OR. single) THEN
665	n=n+1
666	Field_val3d(n,:)=field(ind)%rval4d(k,:,q)
667	ENDIF
668	ENDDO
669	ENDDO
670	! DO l=1,size(field(ind)%rval4d,2)
671	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d(:,l), &
672	start=(/ displ+ncell,l,FieldIndex(Index) /), count=(/n,size(field(ind)%rval4d,2),1 /))
673	! ENDDO
674	DEALLOCATE(field_val3d)
675	ENDDO
676	ENDIF
677
678	! PRINT *,NF90_STRERROR(status)
679	ncell=ncell+n
680
681	ENDDO
682
683	ELSE IF (Field(ind_b)%field_type==field_Z) THEN
684	ncell=1
685	n=0
686	DO ind=ind_b,ind_e
687	d=>domain(ind)
688	CALL swap_geometry(ind)
689	CALL swap_dimensions(ind)
690
691	n=0
692	DO j=jj_begin+1,jj_end
693	DO i=ii_begin,ii_end-1
694	n=n+1
695	ENDDO
696	ENDDO
697
698	DO j=jj_begin,jj_end-1
699	DO i=ii_begin+1,ii_end
700	n=n+1
701	ENDDO
702	ENDDO
703
704	displ=FieldVarId(index)%displ
705
706	IF (field(ind)%ndim==2) THEN
707	ALLOCATE(Field_val2d(n))
708
709	n=0
710	DO j=jj_begin+1,jj_end
711	DO i=ii_begin,ii_end-1
712	n=n+1
713	k=iim*(j-1)+i
714	Field_val2d(n)=field(ind)%rval2d(k+z_down)
715	ENDDO
716	ENDDO
717
718	DO j=jj_begin,jj_end-1
719	DO i=ii_begin+1,ii_end
720	n=n+1
721	k=iim*(j-1)+i
722	Field_val2d(n)=field(ind)%rval2d(k+z_up)
723	ENDDO
724	ENDDO
725
726	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1), &
727	Field_val2d,start=(/ displ+ncell,FieldIndex(Index) /),count=(/n,1 /))
728	DEALLOCATE(field_val2d)
729
730	ELSE IF (field(ind)%ndim==3) THEN
731	ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
732	n=0
733	DO j=jj_begin+1,jj_end
734	DO i=ii_begin,ii_end-1
735	n=n+1
736	k=iim*(j-1)+i
737	Field_val3d(n,:)=field(ind)%rval3d(k+z_down,:)
738	ENDDO
739	ENDDO
740
741	DO j=jj_begin,jj_end-1
742	DO i=ii_begin+1,ii_end
743	n=n+1
744	k=iim*(j-1)+i
745	Field_val3d(n,:)=field(ind)%rval3d(k+z_up,:)
746	ENDDO
747	ENDDO
748	! DO l=1,size(field(ind)%rval3d,2)
749	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d, &
750	start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval3d,2),1 /))
751	! ENDDO
752	DEALLOCATE(field_val3d)
753	ELSE IF (field(1)%ndim==4) THEN
754
755	DO q=1,FieldVarId(index)%size
756	ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
757	n=0
758	DO j=jj_begin+1,jj_end
759	DO i=ii_begin,ii_end-1
760	n=n+1
761	k=iim*(j-1)+i
762	Field_val3d(n,:)=field(ind)%rval4d(k+z_down,:,q)
763	ENDDO
764	ENDDO
765
766	DO j=jj_begin,jj_end-1
767	DO i=ii_begin+1,ii_end
768	n=n+1
769	k=iim*(j-1)+i
770	Field_val3d(n,:)=field(ind)%rval4d(k+z_up,:,q)
771	ENDDO
772	ENDDO
773
774	! DO l=1,size(field(ind)%rval4d,2)
775
776	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d, &
777	start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval4d,2),1 /))
778	! ENDDO
779	DEALLOCATE(field_val3d)
780	ENDDO
781	ENDIF
782
783	! PRINT *,NF90_STRERROR(status)
784	ncell=ncell+n
785
786	ENDDO
787
788	ENDIF
789	status=NF90_SYNC(FieldId(Index))
790
791	END SUBROUTINE Writefield_mpi
792
793
794
795	! SUBROUTINE Create_header(name,field,nind)
796	! USE netcdf
797	! USE field_mod
798	! USE domain_mod
799	! USE spherical_geom_mod
800	! USE dimensions
801	! USE geometry
802	! IMPLICIT NONE
803	! CHARACTER(LEN=*) :: name
804	! TYPE(t_field),POINTER :: field(:)
805	! INTEGER,OPTIONAL,INTENT(IN) :: nind
806	! INTEGER :: ncell
807	! INTEGER :: nvert
808	! REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
809	! TYPE(t_domain),POINTER :: d
810	! INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId
811	! INTEGER :: dim3id,dim4id
812	! INTEGER :: status
813	! INTEGER :: ind,i,j,k,n,q
814	! INTEGER :: iie,jje,iin,jjn
815	! INTEGER :: ind_b,ind_e
816	! INTEGER :: halo_size
817	! LOGICAL :: single
818	! INTEGER :: nij
819	!
820	! NbField=NbField+1
821	! FieldName(NbField)=TRIM(ADJUSTL(name))
822	! FieldIndex(NbField)=1
823	!
824	! IF (PRESENT(nind)) THEN
825	! ind_b=nind
826	! ind_e=nind
827	! halo_size=1
828	! single=.TRUE.
829	! ELSE
830	! ind_b=1
831	! ind_e=ndomain
832	! halo_size=0
833	! single=.FALSE.
834	! ENDIF
835	!
836	! ncell=0
837	!
838	! IF (Field(ind_b)%field_type==field_T) THEN
839	! nvert=6
840	!
841	! DO ind=ind_b,ind_e
842	! d=>domain(ind)
843	!
844	! DO j=d%jj_begin-halo_size,d%jj_end+halo_size
845	! DO i=d%ii_begin-halo_size,d%ii_end+halo_size
846	! IF (single .OR. domain(ind)%own(i,j)) ncell=ncell+1
847	! ENDDO
848	! ENDDO
849
850	! END DO
851	!
852	! status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
853	! FieldId(NbField)=ncid
854	! status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId)
855	! status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
856
857	! IF (Field(ind_b)%ndim==2) THEN
858	! FieldVarId(NbField)%size=1
859	! ALLOCATE(FieldVarId(NbField)%nc_id(1))
860	! ELSE IF (Field(ind_b)%ndim==3) THEN
861	! FieldVarId(NbField)%size=1
862	! ALLOCATE(FieldVarId(NbField)%nc_id(1))
863	! status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval3d,2),dim3id)
864	! ELSE IF (Field(1)%ndim==4) THEN
865	! FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
866	! ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
867	! status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval4d,2),dim3id)
868	! status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id)
869	! ENDIF
870	!
871	! status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
872	!
873	! status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
874	! status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
875	! status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
876	! status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
877	! status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
878	! status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
879	! status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
880	! status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
881	! status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
882	! status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
883
884	! IF (Field(ind_b)%ndim==2) THEN
885	! status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
886	! status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
887	! ELSE IF (Field(ind_b)%ndim==3) THEN
888	! status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
889	! status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
890	! ELSE IF (Field(ind_b)%ndim==4) THEN
891	! DO i=1,FieldVarId(NbField)%size
892	! status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),NF90_DOUBLE,(/ ncellId,dim3id,timeId /), &
893	! FieldVarId(NbField)%nc_id(i))
894	! status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat")
895	! ENDDO
896	! ENDIF
897	!
898	!
899	! status = NF90_ENDDEF(ncid)
900
901	! ncell=1
902	! DO ind=ind_b,ind_e
903	! d=>domain(ind)
904	!
905	! n=0
906	! DO j=d%jj_begin-halo_size,d%jj_end+halo_size
907	! DO i=d%ii_begin-halo_size,d%ii_end+halo_size
908	! IF (single .OR. d%own(i,j)) n=n+1
909	! ENDDO
910	! ENDDO
911	!
912	! ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
913	!
914	! n=0
915	! DO j=d%jj_begin-halo_size,d%jj_end+halo_size
916	! DO i=d%ii_begin-halo_size,d%ii_end+halo_size
917	! IF (d%own(i,j) .OR. single) THEN
918	! n=n+1
919	! CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n))
920	! lon(n)=lon(n)*180/Pi
921	! lat(n)=lat(n)*180/Pi
922	! DO k=0,5
923	! CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n))
924	! bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
925	! bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
926	! ENDDO
927	! ENDIF
928	! ENDDO
929	! ENDDO
930	! status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ ncell /),count=(/ n /))
931	! status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ ncell /),count=(/ n /))
932	! status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
933	! status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
934	!
935	! ncell=ncell+n
936	! DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
937	! END DO
938
939	! ELSE IF (Field(ind_b)%field_type==field_Z) THEN
940	! nvert=3
941	! DO ind=ind_b,ind_e
942	! d=>domain(ind)
943	!
944	! DO j=d%jj_begin+1,d%jj_end
945	! DO i=d%ii_begin,d%ii_end-1
946	! ncell=ncell+1
947	! ENDDO
948	! ENDDO
949
950	! DO j=d%jj_begin,d%jj_end-1
951	! DO i=d%ii_begin+1,d%ii_end
952	! ncell=ncell+1
953	! ENDDO
954	! ENDDO
955
956	! END DO
957	!
958	! status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
959	! FieldId(NbField)=ncid
960	! status = NF90_DEF_DIM(ncid,'cell',ncell,ncellId)
961	! status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
962
963	! IF (Field(ind_b)%ndim==2) THEN
964	! FieldVarId(NbField)%size=1
965	! ALLOCATE(FieldVarId(NbField)%nc_id(1))
966	! ELSE IF (Field(ind_b)%ndim==3) THEN
967	! FieldVarId(NbField)%size=1
968	! ALLOCATE(FieldVarId(NbField)%nc_id(1))
969	! status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval3d,2),dim3id)
970	! ELSE IF (Field(1)%ndim==4) THEN
971	! FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
972	! ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
973	! status = NF90_DEF_DIM(ncid,'Z',size(field(ind_b)%rval4d,2),dim3id)
974	! ENDIF
975
976
977	!
978	! status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
979	!
980	! status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
981	! status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
982	! status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
983	! status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
984	! status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
985	! status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
986	! status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
987	! status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
988	! status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
989	! status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
990
991
992	! IF (Field(ind_b)%ndim==2) THEN
993	! status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
994	! status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
995	! ELSE IF (Field(ind_b)%ndim==3) THEN
996	! status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
997	! status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
998	! ELSE IF (Field(ind_b)%ndim==4) THEN
999	! DO q=1,FieldVarId(NbField)%size
1000	! status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),NF90_DOUBLE, &
1001	! (/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q))
1002	! status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat")
1003	! ENDDO
1004	! ENDIF
1005	!
1006	! status = NF90_ENDDEF(ncid)
1007
1008	! ncell=1
1009	! DO ind=ind_b,ind_e
1010	! d=>domain(ind)
1011	! CALL swap_geometry(ind)
1012	! CALL swap_dimensions(ind)
1013	!
1014	! n=0
1015	! DO j=jj_begin+1,jj_end
1016	! DO i=ii_begin,ii_end-1
1017	! n=n+1
1018	! ENDDO
1019	! ENDDO
1020
1021	! DO j=jj_begin,jj_end-1
1022	! DO i=ii_begin+1,ii_end
1023	! n=n+1
1024	! ENDDO
1025	! ENDDO
1026
1027	! ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
1028	!
1029	! n=0
1030	!
1031	! DO j=jj_begin+1,jj_end
1032	! DO i=ii_begin,ii_end-1
1033	! nij=(j-1)*iim+i
1034	! n=n+1
1035	! CALL xyz2lonlat(xyz_v(nij+z_down,:)/radius,lon(n),lat(n))
1036	! lon(n)=lon(n)*180/Pi
1037	!! IF (lon(n)<0) lon(n)=lon(n)+360
1038	! lat(n)=lat(n)*180/Pi
1039	! CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
1040	! CALL xyz2lonlat(xyz_i(nij+t_ldown,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
1041	! CALL xyz2lonlat(xyz_i(nij+t_rdown,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
1042
1043	! DO k=0,2
1044	! bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
1045	! bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
1046	! IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360
1047	! ENDDO
1048	! ENDDO
1049	! ENDDO
1050
1051	! DO j=jj_begin,jj_end-1
1052	! DO i=ii_begin+1,ii_end
1053	! nij=(j-1)*iim+i
1054	! n=n+1
1055	! CALL xyz2lonlat(xyz_v(nij+z_up,:)/radius,lon(n),lat(n))
1056	! lon(n)=lon(n)*180/Pi
1057	! IF (lon(n)<0) lon(n)=lon(n)+360
1058	! lat(n)=lat(n)*180/Pi
1059	! CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
1060	! CALL xyz2lonlat(xyz_i(nij+t_rup,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
1061	! CALL xyz2lonlat(xyz_i(nij+t_lup,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
1062
1063	! DO k=0,2
1064	! bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
1065	! bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
1066	! IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360
1067	! ENDDO
1068	! ENDDO
1069	! ENDDO
1070	!
1071	!
1072	! status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ ncell /),count=(/ n /))
1073	! status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ ncell /),count=(/ n /))
1074	! status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
1075	! status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,ncell /),count=(/ nvert,n /))
1076	!
1077	! ncell=ncell+n
1078	! DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
1079	! END DO
1080	! ENDIF
1081
1082
1083	!
1084	! status = NF90_CLOSE(ncid)
1085
1086	! END SUBROUTINE Create_Header
1087
1088
1089
1090
1091	SUBROUTINE Create_header_gen(name_in,field,domain_type,ind_b_in,ind_e_in)
1092	USE netcdf_mod
1093	USE field_mod
1094	USE domain_mod
1095	USE metric
1096	USE spherical_geom_mod
1097	! USE dimensions
1098	! USE geometry
1099	IMPLICIT NONE
1100	CHARACTER(LEN=*),INTENT(IN) :: name_in
1101	TYPE(t_field),POINTER :: field(:)
1102	TYPE(t_domain),INTENT(IN),TARGET :: domain_type(:)
1103	INTEGER,OPTIONAL,INTENT(IN) :: ind_b_in
1104	INTEGER,OPTIONAL,INTENT(IN) :: ind_e_in
1105	INTEGER :: ncell
1106	INTEGER :: nvert
1107	REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
1108	TYPE(t_domain),POINTER :: d
1109	INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId
1110	INTEGER :: dim3id,dim4id
1111	INTEGER :: status
1112	INTEGER :: ind,i,j,k,n,q
1113	INTEGER :: iie,jje,iin,jjn
1114	INTEGER :: ind_b,ind_e
1115	INTEGER :: halo_size
1116	LOGICAL :: single
1117	INTEGER :: nij
1118	CHARACTER(LEN=255) :: name
1119
1120
1121	name=TRIM(ADJUSTL(name_in))
1122
1123	IF (PRESENT(ind_b_in) .AND. .NOT. PRESENT(ind_e_in)) THEN
1124	name=TRIM(name)//"_"//TRIM(int2str(ind_b))
1125	ind_b=ind_b_in
1126	ind_e=ind_b_in
1127	halo_size=1
1128	single=.TRUE.
1129	ELSE IF (.NOT. PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
1130	name=TRIM(name)//"_"//TRIM(int2str(ind_e))
1131	ind_b=ind_e_in
1132	ind_e=ind_e_in
1133	halo_size=1
1134	single=.TRUE.
1135	ELSE IF ( PRESENT(ind_b_in) .AND. PRESENT(ind_e_in)) THEN
1136	ind_b=ind_b_in
1137	ind_e=ind_e_in
1138	halo_size=0
1139	single=.FALSE.
1140	ELSE
1141	halo_size=0
1142	ind_b=1
1143	ind_e=ndomain
1144	single=.FALSE.
1145	ENDIF
1146
1147	NbField=NbField+1
1148	FieldName(NbField)=TRIM(ADJUSTL(name))
1149	FieldIndex(NbField)=1
1150
1151	ncell=0
1152
1153	IF (Field(ind_b)%field_type==field_T) THEN
1154	nvert=6
1155
1156	DO ind=ind_b,ind_e
1157	d=>domain_type(ind)
1158
1159	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
1160	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
1161	IF (single .OR. d%assign_domain(i,j)==ind) ncell=ncell+1
1162	ENDDO
1163	ENDDO
1164
1165	END DO
1166
1167	status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
1168	FieldId(NbField)=ncid
1169	status = NF90_DEF_DIM(ncid,'cell_i',ncell,ncellId)
1170	status = NF90_DEF_DIM(ncid,'nvert_i',nvert,nvertid)
1171
1172	IF (Field(ind_b)%ndim==2) THEN
1173	FieldVarId(NbField)%size=1
1174	ALLOCATE(FieldVarId(NbField)%nc_id(1))
1175	ELSE IF (Field(ind_b)%ndim==3) THEN
1176	FieldVarId(NbField)%size=1
1177	ALLOCATE(FieldVarId(NbField)%nc_id(1))
1178	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
1179	ELSE IF (Field(1)%ndim==4) THEN
1180	FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
1181	ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
1182	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
1183	! status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id)
1184	ENDIF
1185
1186	status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
1187
1188	status = NF90_DEF_VAR(ncid,'lon_i',NF90_DOUBLE,(/ ncellId /),lonId)
1189	status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
1190	status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
1191	status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon_i")
1192	status = NF90_DEF_VAR(ncid,'lat_i',NF90_DOUBLE,(/ ncellId /),latId)
1193	status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
1194	status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
1195	status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat_i")
1196	status = NF90_DEF_VAR(ncid,'bounds_lon_i',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
1197	status = NF90_DEF_VAR(ncid,'bounds_lat_i',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
1198
1199	IF (Field(ind_b)%ndim==2) THEN
1200	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
1201	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_i lat_i")
1202	ELSE IF (Field(ind_b)%ndim==3) THEN
1203	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
1204	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_i lat_i")
1205	ELSE IF (Field(ind_b)%ndim==4) THEN
1206	DO i=1,FieldVarId(NbField)%size
1207	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),NF90_DOUBLE,(/ ncellId,dim3id,timeId /), &
1208	FieldVarId(NbField)%nc_id(i))
1209	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon_i lat_i")
1210	ENDDO
1211	ENDIF
1212
1213
1214	status = NF90_ENDDEF(ncid)
1215
1216	! ncell=1
1217	! DO ind=ind_b,ind_e
1218	! d=>domain_type(ind)
1219
1220	! n=0
1221	! DO j=d%jj_begin-halo_size,d%jj_end+halo_size
1222	! DO i=d%ii_begin-halo_size,d%ii_end+halo_size
1223	! IF (single .OR. d%assign_domain(i,j)==ind) n=n+1
1224	! ENDDO
1225	! ENDDO
1226
1227	ALLOCATE(lon(ncell),lat(ncell),bounds_lon(0:nvert-1,ncell),bounds_lat(0:nvert-1,ncell))
1228
1229	n=0
1230	DO ind=ind_b,ind_e
1231	d=>domain_type(ind)
1232	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
1233	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
1234	IF (d%assign_domain(i,j)==ind .OR. single) THEN
1235	n=n+1
1236	CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n))
1237	lon(n)=lon(n)*180/Pi
1238	lat(n)=lat(n)*180/Pi
1239	DO k=0,5
1240	CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n))
1241	bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
1242	bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
1243	ENDDO
1244	ENDIF
1245	ENDDO
1246	ENDDO
1247	ENDDO
1248	status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell /))
1249	status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell /))
1250	status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
1251	status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
1252
1253	! ncell=ncell+n
1254	DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
1255	! END DO
1256
1257	ELSE IF (Field(ind_b)%field_type==field_Z) THEN
1258	nvert=3
1259	DO ind=ind_b,ind_e
1260	d=>domain_type(ind)
1261
1262	DO j=d%jj_begin+1,d%jj_end
1263	DO i=d%ii_begin,d%ii_end-1
1264	ncell=ncell+1
1265	ENDDO
1266	ENDDO
1267
1268	DO j=d%jj_begin,d%jj_end-1
1269	DO i=d%ii_begin+1,d%ii_end
1270	ncell=ncell+1
1271	ENDDO
1272	ENDDO
1273
1274	END DO
1275
1276	status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
1277	FieldId(NbField)=ncid
1278	status = NF90_DEF_DIM(ncid,'cell_v',ncell,ncellId)
1279	status = NF90_DEF_DIM(ncid,'nvert_v',nvert,nvertid)
1280
1281	IF (Field(ind_b)%ndim==2) THEN
1282	FieldVarId(NbField)%size=1
1283	ALLOCATE(FieldVarId(NbField)%nc_id(1))
1284	ELSE IF (Field(ind_b)%ndim==3) THEN
1285	FieldVarId(NbField)%size=1
1286	ALLOCATE(FieldVarId(NbField)%nc_id(1))
1287	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
1288	ELSE IF (Field(1)%ndim==4) THEN
1289	FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
1290	ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
1291	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
1292	ENDIF
1293
1294
1295
1296	status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
1297
1298	status = NF90_DEF_VAR(ncid,'lon_v',NF90_DOUBLE,(/ ncellId /),lonId)
1299	status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
1300	status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
1301	status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon_v")
1302	status = NF90_DEF_VAR(ncid,'lat_v',NF90_DOUBLE,(/ ncellId /),latId)
1303	status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
1304	status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
1305	status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat_v")
1306	status = NF90_DEF_VAR(ncid,'bounds_lon_v',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
1307	status = NF90_DEF_VAR(ncid,'bounds_lat_v',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
1308
1309
1310	IF (Field(ind_b)%ndim==2) THEN
1311	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
1312	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_v lat_v")
1313	ELSE IF (Field(ind_b)%ndim==3) THEN
1314	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
1315	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon_v lat_v")
1316	ELSE IF (Field(ind_b)%ndim==4) THEN
1317	DO q=1,FieldVarId(NbField)%size
1318	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),NF90_DOUBLE, &
1319	(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q))
1320	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon_v lat_v")
1321	ENDDO
1322	ENDIF
1323
1324	status = NF90_ENDDEF(ncid)
1325
1326	! ncell=1
1327	! DO ind=ind_b,ind_e
1328	! d=>domain_type(ind)
1329	!
1330	! n=0
1331	! DO j=d%jj_begin+1,d%jj_end
1332	! DO i=d%ii_begin,d%ii_end-1
1333	! n=n+1
1334	! ENDDO
1335	! ENDDO
1336	!
1337	! DO j=d%jj_begin,d%jj_end-1
1338	! DO i=d%ii_begin+1,d%ii_end
1339	! n=n+1
1340	! ENDDO
1341	! ENDDO
1342
1343	! ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
1344	ALLOCATE(lon(ncell),lat(ncell),bounds_lon(0:nvert-1,ncell),bounds_lat(0:nvert-1,ncell))
1345
1346	n=0
1347
1348	DO ind=ind_b,ind_e
1349	d=>domain_type(ind)
1350	DO j=d%jj_begin+1,d%jj_end
1351	DO i=d%ii_begin,d%ii_end-1
1352	nij=(j-1)*d%iim+i
1353	n=n+1
1354	CALL xyz2lonlat(d%vertex(:,vdown,i,j),lon(n),lat(n))
1355	lon(n)=lon(n)*180/Pi
1356	! IF (lon(n)<0) lon(n)=lon(n)+360
1357	lat(n)=lat(n)*180/Pi
1358	! CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
1359	! CALL xyz2lonlat(xyz_i(nij+t_ldown,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
1360	! CALL xyz2lonlat(xyz_i(nij+t_rdown,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
1361
1362	CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,n), bounds_lat(0,n))
1363	CALL xyz2lonlat(d%xyz(:,i,j-1),bounds_lon(1,n), bounds_lat(1,n))
1364	CALL xyz2lonlat(d%xyz(:,i+1,j-1),bounds_lon(2,n), bounds_lat(2,n))
1365
1366	DO k=0,2
1367	bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
1368	bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
1369	! IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360
1370	ENDDO
1371	ENDDO
1372	ENDDO
1373
1374	DO j=d%jj_begin,d%jj_end-1
1375	DO i=d%ii_begin+1,d%ii_end
1376	nij=(j-1)*d%iim+i
1377	n=n+1
1378	! CALL xyz2lonlat(xyz_v(nij+z_up,:)/radius,lon(n),lat(n))
1379	CALL xyz2lonlat(d%vertex(:,vup,i,j),lon(n),lat(n))
1380	lon(n)=lon(n)*180/Pi
1381	! IF (lon(n)<0) lon(n)=lon(n)+360
1382	lat(n)=lat(n)*180/Pi
1383	! CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
1384	! CALL xyz2lonlat(xyz_i(nij+t_rup,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
1385	! CALL xyz2lonlat(xyz_i(nij+t_lup,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
1386	CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,n), bounds_lat(0,n))
1387	CALL xyz2lonlat(d%xyz(:,i,j+1),bounds_lon(1,n), bounds_lat(1,n))
1388	CALL xyz2lonlat(d%xyz(:,i-1,j+1),bounds_lon(2,n), bounds_lat(2,n))
1389
1390	DO k=0,2
1391	bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
1392	bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
1393	! IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360
1394	ENDDO
1395	ENDDO
1396	ENDDO
1397	ENDDO
1398
1399	status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell /))
1400	status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell /))
1401	status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
1402	status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell /))
1403
1404	! ncell=ncell+n
1405	DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
1406	! END DO
1407	ENDIF
1408
1409
1410
1411	! status = NF90_CLOSE(ncid)
1412
1413	END SUBROUTINE Create_Header_gen
1414
1415	SUBROUTINE Create_header_mpi(name,field,nind)
1416	USE netcdf_mod
1417	USE field_mod
1418	USE domain_mod
1419	USE spherical_geom_mod
1420	USE dimensions
1421	USE geometry
1422	USE mpi_mod
1423	USE mpipara
1424	IMPLICIT NONE
1425	CHARACTER(LEN=*) :: name
1426	TYPE(t_field),POINTER :: field(:)
1427	INTEGER,OPTIONAL,INTENT(IN) :: nind
1428	INTEGER :: ncell
1429	INTEGER :: nvert
1430	REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
1431	TYPE(t_domain),POINTER :: d
1432	INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId
1433	INTEGER :: dim3id,dim4id
1434	INTEGER :: status
1435	INTEGER :: ind,i,j,k,n,q
1436	INTEGER :: iie,jje,iin,jjn
1437	INTEGER :: ind_b,ind_e
1438	INTEGER :: halo_size
1439	LOGICAL :: single
1440	INTEGER :: nij
1441	INTEGER :: ncell_glo(0:mpi_size-1)
1442	INTEGER :: displ, ncell_tot
1443
1444
1445	NbField=NbField+1
1446	FieldName(NbField)=TRIM(ADJUSTL(name))
1447	FieldIndex(NbField)=1
1448
1449	IF (PRESENT(nind)) THEN
1450	ind_b=nind
1451	ind_e=nind
1452	halo_size=1
1453	single=.TRUE.
1454	ELSE
1455	ind_b=1
1456	ind_e=ndomain
1457	halo_size=0
1458	single=.FALSE.
1459	ENDIF
1460
1461	ncell=0
1462
1463	IF (Field(ind_b)%field_type==field_T) THEN
1464	nvert=6
1465
1466	DO ind=ind_b,ind_e
1467	d=>domain(ind)
1468
1469	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
1470	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
1471	IF (single .OR. domain(ind)%own(i,j)) ncell=ncell+1
1472	ENDDO
1473	ENDDO
1474
1475	END DO
1476
1477	CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
1478
1479	displ=0
1480	DO i=1,mpi_rank
1481	displ=displ+ncell_glo(i-1)
1482	ENDDO
1483	FieldVarId(NbField)%displ=displ
1484	ncell_tot=sum(ncell_glo(:))
1485
1486	! status = NF90_CREATE_PAR(TRIM(ADJUSTL(name))//'.nc', IOR(NF90_NETCDF4, NF90_MPIIO), comm_icosa, MPI_INFO_NULL, ncid)
1487	FieldId(NbField)=ncid
1488	status = NF90_DEF_DIM(ncid,'cell',ncell_tot,ncellId)
1489	status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
1490
1491	IF (Field(ind_b)%ndim==2) THEN
1492	FieldVarId(NbField)%size=1
1493	ALLOCATE(FieldVarId(NbField)%nc_id(1))
1494	ELSE IF (Field(ind_b)%ndim==3) THEN
1495	FieldVarId(NbField)%size=1
1496	ALLOCATE(FieldVarId(NbField)%nc_id(1))
1497	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
1498	ELSE IF (Field(1)%ndim==4) THEN
1499	FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
1500	ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
1501	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
1502	! status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id)
1503	ENDIF
1504
1505	status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
1506
1507	status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
1508	status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
1509	status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
1510	status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
1511	status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
1512	status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
1513	status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
1514	status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
1515	status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
1516	status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
1517
1518	IF (Field(ind_b)%ndim==2) THEN
1519	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
1520	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
1521	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,1/))
1522	ELSE IF (Field(ind_b)%ndim==3) THEN
1523	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
1524	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
1525	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, &
1526	(/ncell_tot,size(field(ind_b)%rval3d,2),1/))
1527	ELSE IF (Field(ind_b)%ndim==4) THEN
1528	DO i=1,FieldVarId(NbField)%size
1529	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),NF90_DOUBLE,(/ ncellId,dim3id,timeId /), &
1530	FieldVarId(NbField)%nc_id(i))
1531	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat")
1532	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(q), NF90_CHUNKED, &
1533	(/ncell_tot,size(field(ind_b)%rval4d,2),1/))
1534	ENDDO
1535	ENDIF
1536
1537
1538	status = NF90_ENDDEF(ncid)
1539
1540	ncell=1
1541	DO ind=ind_b,ind_e
1542	d=>domain(ind)
1543
1544	n=0
1545	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
1546	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
1547	IF (single .OR. d%own(i,j)) n=n+1
1548	ENDDO
1549	ENDDO
1550
1551	ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
1552
1553	n=0
1554	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
1555	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
1556	IF (d%own(i,j) .OR. single) THEN
1557	n=n+1
1558	CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n))
1559	lon(n)=lon(n)*180/Pi
1560	lat(n)=lat(n)*180/Pi
1561	DO k=0,5
1562	CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n))
1563	bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
1564	bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
1565	ENDDO
1566	ENDIF
1567	ENDDO
1568	ENDDO
1569	status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ displ+ncell /),count=(/ n /))
1570	status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ displ+ncell /),count=(/ n /))
1571	status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
1572	status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
1573
1574	ncell=ncell+n
1575	DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
1576	END DO
1577
1578	ELSE IF (Field(ind_b)%field_type==field_Z) THEN
1579	nvert=3
1580	DO ind=ind_b,ind_e
1581	d=>domain(ind)
1582
1583	DO j=d%jj_begin+1,d%jj_end
1584	DO i=d%ii_begin,d%ii_end-1
1585	ncell=ncell+1
1586	ENDDO
1587	ENDDO
1588
1589	DO j=d%jj_begin,d%jj_end-1
1590	DO i=d%ii_begin+1,d%ii_end
1591	ncell=ncell+1
1592	ENDDO
1593	ENDDO
1594
1595	END DO
1596
1597	CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
1598
1599	displ=0
1600	DO i=1,mpi_rank
1601	displ=displ+ncell_glo(i-1)
1602	ENDDO
1603	FieldVarId(NbField)%displ=displ
1604	ncell_tot=sum(ncell_glo(:))
1605
1606	! status = NF90_CREATE_PAR(TRIM(ADJUSTL(name))//'.nc',IOR(NF90_NETCDF4, NF90_MPIIO), comm_icosa, MPI_INFO_NULL, ncid)
1607	! status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
1608	FieldId(NbField)=ncid
1609	status = NF90_DEF_DIM(ncid,'cell',ncell_tot,ncellId)
1610	status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
1611
1612	IF (Field(ind_b)%ndim==2) THEN
1613	FieldVarId(NbField)%size=1
1614	ALLOCATE(FieldVarId(NbField)%nc_id(1))
1615	ELSE IF (Field(ind_b)%ndim==3) THEN
1616	FieldVarId(NbField)%size=1
1617	ALLOCATE(FieldVarId(NbField)%nc_id(1))
1618	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
1619	ELSE IF (Field(1)%ndim==4) THEN
1620	FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
1621	ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
1622	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
1623	ENDIF
1624
1625
1626
1627	status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
1628
1629	status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
1630	status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
1631	status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
1632	status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
1633	status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
1634	status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
1635	status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
1636	status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
1637	status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
1638	status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
1639
1640
1641	IF (Field(ind_b)%ndim==2) THEN
1642	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
1643	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
1644	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,1/))
1645	ELSE IF (Field(ind_b)%ndim==3) THEN
1646	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),NF90_DOUBLE,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
1647	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
1648	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, &
1649	(/ncell_tot,size(field(ind_b)%rval3d,2),1/))
1650	ELSE IF (Field(ind_b)%ndim==4) THEN
1651	DO q=1,FieldVarId(NbField)%size
1652	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)//int2str(q)),NF90_DOUBLE, &
1653	(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q))
1654	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat")
1655	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(q), NF90_CHUNKED, &
1656	(/ncell_tot,size(field(ind_b)%rval4d,2),1/))
1657	ENDDO
1658	ENDIF
1659
1660	status = NF90_ENDDEF(ncid)
1661
1662	ncell=1
1663	DO ind=ind_b,ind_e
1664	d=>domain(ind)
1665	CALL swap_geometry(ind)
1666	CALL swap_dimensions(ind)
1667
1668	n=0
1669	DO j=jj_begin+1,jj_end
1670	DO i=ii_begin,ii_end-1
1671	n=n+1
1672	ENDDO
1673	ENDDO
1674
1675	DO j=jj_begin,jj_end-1
1676	DO i=ii_begin+1,ii_end
1677	n=n+1
1678	ENDDO
1679	ENDDO
1680
1681	ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
1682
1683	n=0
1684
1685	DO j=jj_begin+1,jj_end
1686	DO i=ii_begin,ii_end-1
1687	nij=(j-1)*iim+i
1688	n=n+1
1689	CALL xyz2lonlat(xyz_v(nij+z_down,:)/radius,lon(n),lat(n))
1690	lon(n)=lon(n)*180/Pi
1691	! IF (lon(n)<0) lon(n)=lon(n)+360
1692	lat(n)=lat(n)*180/Pi
1693	CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
1694	CALL xyz2lonlat(xyz_i(nij+t_ldown,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
1695	CALL xyz2lonlat(xyz_i(nij+t_rdown,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
1696
1697	DO k=0,2
1698	bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
1699	bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
1700	! IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360
1701	ENDDO
1702	ENDDO
1703	ENDDO
1704
1705	DO j=jj_begin,jj_end-1
1706	DO i=ii_begin+1,ii_end
1707	nij=(j-1)*iim+i
1708	n=n+1
1709	CALL xyz2lonlat(xyz_v(nij+z_up,:)/radius,lon(n),lat(n))
1710	lon(n)=lon(n)*180/Pi
1711	! IF (lon(n)<0) lon(n)=lon(n)+360
1712	lat(n)=lat(n)*180/Pi
1713	CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
1714	CALL xyz2lonlat(xyz_i(nij+t_rup,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
1715	CALL xyz2lonlat(xyz_i(nij+t_lup,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
1716
1717	DO k=0,2
1718	bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
1719	bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
1720	! IF (bounds_lon(k,n)<0) bounds_lon(k,n)=bounds_lon(k,n)+360
1721	ENDDO
1722	ENDDO
1723	ENDDO
1724
1725
1726	status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ displ+ncell /),count=(/ n /))
1727	status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ displ+ncell /),count=(/ n /))
1728	status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
1729	status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
1730
1731	ncell=ncell+n
1732	DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
1733	END DO
1734	ENDIF
1735
1736
1737
1738	! status = NF90_CLOSE(ncid)
1739
1740	end subroutine Create_Header_mpi
1741
1742	SUBROUTINE Close_files
1743	USE netcdf
1744	IMPLICIT NONE
1745	INTEGER :: i,k,status
1746
1747	DO i=1,NbField
1748	status=NF90_CLOSE(FieldId(i))
1749	ENDDO
1750	END SUBROUTINE Close_files
1751
1752
1753	function int2str(int)
1754	implicit none
1755	integer, parameter :: MaxLen=10
1756	integer,intent(in) :: int
1757	character(len=MaxLen) :: int2str
1758	logical :: flag
1759	integer :: i
1760	flag=.true.
1761
1762	i=int
1763
1764	int2str=''
1765	do while (flag)
1766	int2str=CHAR(MOD(i,10)+48)//int2str
1767	i=i/10
1768	if (i==0) flag=.false.
1769	enddo
1770	end function int2str
1771
1772	end module write_field
1773

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

Download in other formats: