Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

write_field_mpi.f90 @ 880

Last change on this file since 880 was 880, checked in by dubos, 5 years ago
devel : store cell bounds once, use them for XIOS later
File size: 20.3 KB

Line
1	module write_field_mpi_mod
2	USE genmod
3	USE write_field_vars_mod
4	IMPLICIT NONE
5	PRIVATE
6
7	! TYPE ncvar
8	! INTEGER :: size
9	! INTEGER,POINTER :: nc_id(:)
10	! INTEGER :: displ
11	! END TYPE ncvar
12	!
13	! INTEGER, PARAMETER :: MaxWriteField = 1000
14	! INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldId
15	! TYPE(ncvar), dimension(MaxWriteField),SAVE :: FieldVarId
16	! INTEGER, DIMENSION(MaxWriteField),SAVE :: FieldIndex
17	! CHARACTER(len=255), DIMENSION(MaxWriteField) :: FieldName
18	!
19	! INTEGER,SAVE :: NbField = 0
20	!
21	! PUBLIC init_writeField, writefield, close_files
22
23	CONTAINS
24
25	SUBROUTINE Writefield_mpi(name_in,field,nind)
26	USE netcdf_mod
27	USE domain_mod
28	use field_mod
29	USE dimensions
30	USE geometry
31	IMPLICIT NONE
32	CHARACTER(LEN=*),INTENT(IN) :: name_in
33	TYPE(t_field),POINTER :: field(:)
34	INTEGER,OPTIONAL,INTENT(IN) :: nind
35	REAL(r8),ALLOCATABLE :: field_val2d(:)
36	REAL(r8),ALLOCATABLE :: field_val3d(:,:)
37	REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)
38	TYPE(t_domain),POINTER :: d
39	INTEGER :: Index
40	INTEGER :: ind,i,j,l,k,n,ncell,q
41	INTEGER :: iie,jje,iin,jjn
42	INTEGER :: status
43	CHARACTER(len=255) :: name
44	CHARACTER(len=255) :: str_ind
45	INTEGER :: ind_b,ind_e
46	INTEGER :: halo_size
47	LOGICAL :: single
48	INTEGER :: displ
49
50	name=TRIM(ADJUSTL(name_in))
51
52	IF (PRESENT(nind)) THEN
53	name=TRIM(name)//"_"//TRIM(int2str(nind))
54	PRINT *,"NAME",nind,int2str(nind),name
55	ind_b=nind
56	ind_e=nind
57	halo_size=1
58	single=.TRUE.
59	ELSE
60	ind_b=1
61	ind_e=ndomain
62	halo_size=0
63	single=.FALSE.
64	ENDIF
65
66	Index=GetFieldIndex(name)
67	if (Index==-1) then
68	call create_header_mpi(name,field,nind)
69	Index=GetFieldIndex(name)
70	else
71	FieldIndex(Index)=FieldIndex(Index)+1.
72	endif
73
74	IF (Field(ind_b)%field_type==field_T) THEN
75	ncell=1
76	DO ind=ind_b,ind_e
77	d=>domain(ind)
78	IF (Field(ind)%field_type/=field_T) THEN
79	PRINT *,"Writefield, grille non geree"
80	RETURN
81	ENDIF
82
83	n=0
84	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
85	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
86	IF (d%own(i,j) .OR. single) n=n+1
87	ENDDO
88	ENDDO
89
90	displ=FieldVarId(index)%displ
91
92	IF (field(ind)%ndim==2) THEN
93	ALLOCATE(Field_val2d(n))
94	n=0
95	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
96	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
97	k=d%iim*(j-1)+i
98	IF (d%own(i,j) .OR. single) THEN
99	n=n+1
100	Field_val2d(n)=field(ind)%rval2d(k)
101	ENDIF
102	ENDDO
103	ENDDO
104	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val2d, &
105	start=(/ displ+ncell,FieldIndex(Index) /),count=(/n,1 /))
106	DEALLOCATE(field_val2d)
107	ELSE IF (field(ind)%ndim==3) THEN
108	ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
109	n=0
110	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
111	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
112	k=d%iim*(j-1)+i
113	IF (d%own(i,j) .OR. single) THEN
114	n=n+1
115	Field_val3d(n,:)=field(ind)%rval3d(k,:)
116	ENDIF
117	ENDDO
118	ENDDO
119	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d, &
120	start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval3d,2),1 /))
121	DEALLOCATE(field_val3d)
122
123	ELSE IF (field(1)%ndim==4) THEN
124
125	DO q=1,FieldVarId(index)%size
126
127	ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
128	n=0
129	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
130	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
131	k=d%iim*(j-1)+i
132	IF (d%own(i,j) .OR. single) THEN
133	n=n+1
134	Field_val3d(n,:)=field(ind)%rval4d(k,:,q)
135	ENDIF
136	ENDDO
137	ENDDO
138
139	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d(:,l), &
140	start=(/ displ+ncell,l,FieldIndex(Index) /), count=(/n,size(field(ind)%rval4d,2),1 /))
141	DEALLOCATE(field_val3d)
142	ENDDO
143	ENDIF
144
145	ncell=ncell+n
146
147	ENDDO
148
149	ELSE IF (Field(ind_b)%field_type==field_Z) THEN
150	ncell=1
151	n=0
152	DO ind=ind_b,ind_e
153	d=>domain(ind)
154	CALL swap_geometry(ind)
155	CALL swap_dimensions(ind)
156
157	n=0
158	DO j=jj_begin+1,jj_end
159	DO i=ii_begin,ii_end-1
160	n=n+1
161	ENDDO
162	ENDDO
163
164	DO j=jj_begin,jj_end-1
165	DO i=ii_begin+1,ii_end
166	n=n+1
167	ENDDO
168	ENDDO
169
170	displ=FieldVarId(index)%displ
171
172	IF (field(ind)%ndim==2) THEN
173	ALLOCATE(Field_val2d(n))
174
175	n=0
176	DO j=jj_begin+1,jj_end
177	DO i=ii_begin,ii_end-1
178	n=n+1
179	k=iim*(j-1)+i
180	Field_val2d(n)=field(ind)%rval2d(k+z_down)
181	ENDDO
182	ENDDO
183
184	DO j=jj_begin,jj_end-1
185	DO i=ii_begin+1,ii_end
186	n=n+1
187	k=iim*(j-1)+i
188	Field_val2d(n)=field(ind)%rval2d(k+z_up)
189	ENDDO
190	ENDDO
191
192	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1), &
193	Field_val2d,start=(/ displ+ncell,FieldIndex(Index) /),count=(/n,1 /))
194	DEALLOCATE(field_val2d)
195
196	ELSE IF (field(ind)%ndim==3) THEN
197	ALLOCATE(Field_val3d(n,size(field(ind)%rval3d,2)))
198	n=0
199	DO j=jj_begin+1,jj_end
200	DO i=ii_begin,ii_end-1
201	n=n+1
202	k=iim*(j-1)+i
203	Field_val3d(n,:)=field(ind)%rval3d(k+z_down,:)
204	ENDDO
205	ENDDO
206
207	DO j=jj_begin,jj_end-1
208	DO i=ii_begin+1,ii_end
209	n=n+1
210	k=iim*(j-1)+i
211	Field_val3d(n,:)=field(ind)%rval3d(k+z_up,:)
212	ENDDO
213	ENDDO
214
215	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(1),Field_val3d, &
216	start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval3d,2),1 /))
217	DEALLOCATE(field_val3d)
218
219	ELSE IF (field(1)%ndim==4) THEN
220
221	DO q=1,FieldVarId(index)%size
222	ALLOCATE(Field_val3d(n,size(field(ind)%rval4d,2)))
223	n=0
224	DO j=jj_begin+1,jj_end
225	DO i=ii_begin,ii_end-1
226	n=n+1
227	k=iim*(j-1)+i
228	Field_val3d(n,:)=field(ind)%rval4d(k+z_down,:,q)
229	ENDDO
230	ENDDO
231
232	DO j=jj_begin,jj_end-1
233	DO i=ii_begin+1,ii_end
234	n=n+1
235	k=iim*(j-1)+i
236	Field_val3d(n,:)=field(ind)%rval4d(k+z_up,:,q)
237	ENDDO
238	ENDDO
239
240	status=NF90_PUT_VAR(FieldId(Index),FieldVarId(index)%nc_id(q),Field_val3d, &
241	start=(/ displ+ncell,1,FieldIndex(Index) /), count=(/n,size(field(ind)%rval4d,2),1 /))
242	DEALLOCATE(field_val3d)
243	ENDDO
244	ENDIF
245
246	ncell=ncell+n
247
248	ENDDO
249
250	ENDIF
251	status=NF90_SYNC(FieldId(Index))
252
253	END SUBROUTINE Writefield_mpi
254
255
256	SUBROUTINE Create_header_mpi(name,field,nind)
257	USE netcdf_mod
258	USE field_mod
259	USE domain_mod
260	USE spherical_geom_mod
261	USE dimensions
262	USE geometry
263	USE mpi_mod
264	USE mpipara
265	IMPLICIT NONE
266	CHARACTER(LEN=*) :: name
267	CHARACTER(LEN=LEN_TRIM(ADJUSTL(name))) :: name_adj
268	TYPE(t_field),POINTER :: field(:)
269	INTEGER,OPTIONAL,INTENT(IN) :: nind
270	INTEGER :: ncell
271	INTEGER :: nvert
272	REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
273	TYPE(t_domain),POINTER :: d
274	INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId
275	INTEGER :: dim3id,dim4id
276	INTEGER :: status
277	INTEGER :: ind,i,j,k,n,q
278	INTEGER :: iie,jje,iin,jjn
279	INTEGER :: ind_b,ind_e
280	INTEGER :: halo_size
281	LOGICAL :: single
282	INTEGER :: nij
283	INTEGER :: ncell_glo(0:mpi_size-1)
284	INTEGER :: displ, ncell_tot
285
286
287	NbField=NbField+1
288	name_adj=TRIM(ADJUSTL(name)) ! work around ICE with pgf90
289	FieldName(NbField)=name_adj
290	FieldIndex(NbField)=1
291
292	IF (PRESENT(nind)) THEN
293	ind_b=nind
294	ind_e=nind
295	halo_size=1
296	single=.TRUE.
297	ELSE
298	ind_b=1
299	ind_e=ndomain
300	halo_size=0
301	single=.FALSE.
302	ENDIF
303
304	ncell=0
305
306	IF (Field(ind_b)%field_type==field_T) THEN
307	nvert=6
308
309	DO ind=ind_b,ind_e
310	d=>domain(ind)
311
312	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
313	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
314	IF (single .OR. domain(ind)%own(i,j)) ncell=ncell+1
315	ENDDO
316	ENDDO
317
318	END DO
319
320	CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
321
322	displ=0
323	DO i=1,mpi_rank
324	displ=displ+ncell_glo(i-1)
325	ENDDO
326	FieldVarId(NbField)%displ=displ
327	ncell_tot=sum(ncell_glo(:))
328
329	! status = NF90_CREATE_PAR(TRIM(ADJUSTL(name))//'.nc', IOR(NF90_NETCDF4, NF90_MPIIO), comm_icosa, MPI_INFO_NULL, ncid)
330	FieldId(NbField)=ncid
331	status = NF90_DEF_DIM(ncid,'cell',ncell_tot,ncellId)
332	status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
333
334	IF (Field(ind_b)%ndim==2) THEN
335	FieldVarId(NbField)%size=1
336	ALLOCATE(FieldVarId(NbField)%nc_id(1))
337	ELSE IF (Field(ind_b)%ndim==3) THEN
338	FieldVarId(NbField)%size=1
339	ALLOCATE(FieldVarId(NbField)%nc_id(1))
340	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
341	ELSE IF (Field(1)%ndim==4) THEN
342	FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
343	ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
344	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
345	! status = NF90_DEF_DIM(ncid,'Q',size(field(ind_b)%rval4d,3),dim4id)
346	ENDIF
347
348	status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
349
350	status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
351	status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
352	status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
353	status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
354	status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
355	status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
356	status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
357	status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
358	status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
359	status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
360
361	IF (Field(ind_b)%ndim==2) THEN
362	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
363	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
364	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,1/))
365	ELSE IF (Field(ind_b)%ndim==3) THEN
366	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
367	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
368	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, &
369	(/ncell_tot,size(field(ind_b)%rval3d,2),1/))
370	ELSE IF (Field(ind_b)%ndim==4) THEN
371	DO i=1,FieldVarId(NbField)%size
372	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name))//int2str(i),ncprec,(/ ncellId,dim3id,timeId /), &
373	FieldVarId(NbField)%nc_id(i))
374	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(i),"coordinates","lon lat")
375	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(q), NF90_CHUNKED, &
376	(/ncell_tot,size(field(ind_b)%rval4d,2),1/))
377	ENDDO
378	ENDIF
379
380
381	status = NF90_ENDDEF(ncid)
382
383	ncell=1
384	DO ind=ind_b,ind_e
385	d=>domain(ind)
386
387	n=0
388	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
389	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
390	IF (single .OR. d%own(i,j)) n=n+1
391	ENDDO
392	ENDDO
393
394	ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
395
396	n=0
397	DO j=d%jj_begin-halo_size,d%jj_end+halo_size
398	DO i=d%ii_begin-halo_size,d%ii_end+halo_size
399	IF (d%own(i,j) .OR. single) THEN
400	n=n+1
401	CALL xyz2lonlat(d%xyz(:,i,j),lon(n),lat(n))
402	lon(n)=lon(n)*180/Pi
403	lat(n)=lat(n)*180/Pi
404	DO k=0,5
405	CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,n), bounds_lat(k,n))
406	bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
407	bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
408	ENDDO
409	ENDIF
410	ENDDO
411	ENDDO
412	status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ displ+ncell /),count=(/ n /))
413	status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ displ+ncell /),count=(/ n /))
414	status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
415	status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
416
417	ncell=ncell+n
418	DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
419	END DO
420
421	ELSE IF (Field(ind_b)%field_type==field_Z) THEN
422	nvert=3
423	DO ind=ind_b,ind_e
424	d=>domain(ind)
425
426	DO j=d%jj_begin+1,d%jj_end
427	DO i=d%ii_begin,d%ii_end-1
428	ncell=ncell+1
429	ENDDO
430	ENDDO
431
432	DO j=d%jj_begin,d%jj_end-1
433	DO i=d%ii_begin+1,d%ii_end
434	ncell=ncell+1
435	ENDDO
436	ENDDO
437
438	END DO
439
440	CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
441
442	displ=0
443	DO i=1,mpi_rank
444	displ=displ+ncell_glo(i-1)
445	ENDDO
446	FieldVarId(NbField)%displ=displ
447	ncell_tot=sum(ncell_glo(:))
448
449	! status = NF90_CREATE_PAR(TRIM(ADJUSTL(name))//'.nc',IOR(NF90_NETCDF4, NF90_MPIIO), comm_icosa, MPI_INFO_NULL, ncid)
450	! status = NF90_CREATE(TRIM(ADJUSTL(name))//'.nc', NF90_CLOBBER, ncid)
451	FieldId(NbField)=ncid
452	status = NF90_DEF_DIM(ncid,'cell',ncell_tot,ncellId)
453	status = NF90_DEF_DIM(ncid,'nvert',nvert,nvertid)
454
455	IF (Field(ind_b)%ndim==2) THEN
456	FieldVarId(NbField)%size=1
457	ALLOCATE(FieldVarId(NbField)%nc_id(1))
458	ELSE IF (Field(ind_b)%ndim==3) THEN
459	FieldVarId(NbField)%size=1
460	ALLOCATE(FieldVarId(NbField)%nc_id(1))
461	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval3d,2),dim3id)
462	ELSE IF (Field(1)%ndim==4) THEN
463	FieldVarId(NbField)%size=size(field(ind_b)%rval4d,3)
464	ALLOCATE(FieldVarId(NbField)%nc_id(FieldVarId(NbField)%size))
465	status = NF90_DEF_DIM(ncid,'lev',size(field(ind_b)%rval4d,2),dim3id)
466	ENDIF
467
468
469
470	status = NF90_DEF_DIM(ncid,'time_counter',NF90_UNLIMITED,timeId)
471
472	status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ ncellId /),lonId)
473	status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
474	status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
475	status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
476	status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ ncellId /),latId)
477	status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
478	status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
479	status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
480	status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_lonId)
481	status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ nvertid,ncellId /),bounds_latId)
482
483
484	IF (Field(ind_b)%ndim==2) THEN
485	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,timeId /),FieldVarId(NbField)%nc_id(1))
486	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
487	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, (/ncell_tot,1/))
488	ELSE IF (Field(ind_b)%ndim==3) THEN
489	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(name)),ncprec,(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(1))
490	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(1),"coordinates","lon lat")
491	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(1), NF90_CHUNKED, &
492	(/ncell_tot,size(field(ind_b)%rval3d,2),1/))
493	ELSE IF (Field(ind_b)%ndim==4) THEN
494	DO q=1,FieldVarId(NbField)%size
495	status = NF90_DEF_VAR(ncid,name_adj//int2str(q),ncprec, &
496	(/ ncellId,dim3id,timeId /),FieldVarId(NbField)%nc_id(q))
497	status = NF90_PUT_ATT(ncid,FieldVarId(NbField)%nc_id(q),"coordinates","lon lat")
498	status = NF90_DEF_VAR_CHUNKING(ncid, FieldVarId(NbField)%nc_id(q), NF90_CHUNKED, &
499	(/ncell_tot,size(field(ind_b)%rval4d,2),1/))
500	ENDDO
501	ENDIF
502
503	status = NF90_ENDDEF(ncid)
504
505	ncell=1
506	DO ind=ind_b,ind_e
507	d=>domain(ind)
508	CALL swap_geometry(ind)
509	CALL swap_dimensions(ind)
510
511	n=0
512	DO j=jj_begin+1,jj_end
513	DO i=ii_begin,ii_end-1
514	n=n+1
515	ENDDO
516	ENDDO
517
518	DO j=jj_begin,jj_end-1
519	DO i=ii_begin+1,ii_end
520	n=n+1
521	ENDDO
522	ENDDO
523
524	ALLOCATE(lon(n),lat(n),bounds_lon(0:nvert-1,n),bounds_lat(0:nvert-1,n))
525
526	n=0
527
528	DO j=jj_begin+1,jj_end
529	DO i=ii_begin,ii_end-1
530	nij=(j-1)*iim+i
531	n=n+1
532	CALL xyz2lonlat(xyz_v(nij+z_down,:)/radius,lon(n),lat(n))
533	lon(n)=lon(n)*180/Pi
534	lat(n)=lat(n)*180/Pi
535	CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
536	CALL xyz2lonlat(xyz_i(nij+t_ldown,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
537	CALL xyz2lonlat(xyz_i(nij+t_rdown,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
538
539	DO k=0,2
540	bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
541	bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
542	ENDDO
543	ENDDO
544	ENDDO
545
546	DO j=jj_begin,jj_end-1
547	DO i=ii_begin+1,ii_end
548	nij=(j-1)*iim+i
549	n=n+1
550	CALL xyz2lonlat(xyz_v(nij+z_up,:)/radius,lon(n),lat(n))
551	lon(n)=lon(n)*180/Pi
552	lat(n)=lat(n)*180/Pi
553	CALL xyz2lonlat(xyz_i(nij,:)/radius,bounds_lon(0,n), bounds_lat(0,n))
554	CALL xyz2lonlat(xyz_i(nij+t_rup,:)/radius,bounds_lon(1,n), bounds_lat(1,n))
555	CALL xyz2lonlat(xyz_i(nij+t_lup,:)/radius,bounds_lon(2,n), bounds_lat(2,n))
556
557	DO k=0,2
558	bounds_lat(k,n)=bounds_lat(k,n)*180/Pi
559	bounds_lon(k,n)=bounds_lon(k,n)*180/Pi
560	ENDDO
561	ENDDO
562	ENDDO
563
564
565	status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ displ+ncell /),count=(/ n /))
566	status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ displ+ncell /),count=(/ n /))
567	status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
568	status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,displ+ncell /),count=(/ nvert,n /))
569
570	ncell=ncell+n
571	DEALLOCATE(lon,lat,bounds_lon,bounds_lat)
572	END DO
573	ENDIF
574
575
576	END SUBROUTINE Create_Header_mpi
577
578	end module write_field_mpi_mod
579

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

Context Navigation

source: codes/icosagcm/devel/src/output/write_field_mpi.f90 @ 880

Download in other formats: