source: codes/icosagcm/trunk/src/xios_mod.F90 @ 176

Last change on this file since 176 was 173, checked in by ymipsl, 11 years ago

bug fix for output vorticity field with XIOS

YM
File size: 10.9 KB
Line 
1MODULE xios_mod
2
3#ifdef CPP_USING_XIOS
4   USE xios
5#endif
6
7  PUBLIC
8  LOGICAL,SAVE :: using_xios
9  INTEGER,SAVE :: ncell_i
10  INTEGER,SAVE :: ncell_v
11
12  PRIVATE ncell_i,ncell_v
13 
14CONTAINS
15
16#ifdef CPP_USING_XIOS
17 
18 SUBROUTINE xios_init
19   USE IOIPSL
20   IMPLICIT NONE
21
22   using_xios=.TRUE.
23   
24 END SUBROUTINE xios_init 
25 
26 SUBROUTINE xios_init_write_field
27 USE genmod
28 USE mpipara
29 USE xios
30 USE grid_param
31 USE domain_mod
32 USE dimensions
33 USE spherical_geom_mod
34 USE geometry
35 USE mpi_mod
36 USE time_mod
37 USE metric, ONLY : vup,vdown
38 IMPLICIT NONE
39  TYPE(xios_context) :: ctx_hdl
40  TYPE(xios_time)      :: dtime
41  REAL(rstd) :: lev_value(llm)
42  REAL(rstd) :: lev_valuep1(llm+1)
43  INTEGER :: ncell, ncell_tot, ncell_glo(0:mpi_size-1), displ
44  INTEGER :: ind, i,j,k,l
45  REAL(rstd),ALLOCATABLE    :: lon(:), lat(:), bounds_lon(:,:), bounds_lat(:,:)
46  TYPE(t_domain),POINTER :: d
47
48   CALL xios_context_initialize("icosagcm",comm_icosa)
49   CALL xios_get_handle("icosagcm",ctx_hdl)
50   CALL xios_set_current_context(ctx_hdl)
51   lev_value(:) = (/ (l,l=1,llm) /)     
52   lev_valuep1(:) = (/ (l,l=1,llm+1) /)     
53   CALL xios_set_axis_attr("lev",size=llm ,value=lev_value) ;
54   CALL xios_set_axis_attr("levp1",size=llm+1 ,value=lev_value) ;
55   
56   ncell=0
57   DO ind=1,ndomain
58     d=>domain(ind)
59       
60     DO j=d%jj_begin,d%jj_end
61       DO i=d%ii_begin,d%ii_end
62         IF (domain(ind)%own(i,j)) ncell=ncell+1
63       ENDDO
64     ENDDO
65   ENDDO     
66   ncell_i=ncell
67   
68   CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
69
70   displ=0
71   DO i=1,mpi_rank
72     displ=displ+ncell_glo(i-1)
73   ENDDO
74
75   ncell_tot=sum(ncell_glo(:))
76   
77   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:5,ncell), bounds_lat(0:5,ncell)) 
78   
79   ncell=0
80   DO ind=1,ndomain
81     d=>domain(ind)
82       
83     DO j=d%jj_begin,d%jj_end
84       DO i=d%ii_begin,d%ii_end
85         IF (domain(ind)%own(i,j)) THEN
86           ncell=ncell+1
87           CALL xyz2lonlat(d%xyz(:,i,j),lon(ncell),lat(ncell))
88           lon(ncell)=lon(ncell)*180/Pi
89           lat(ncell)=lat(ncell)*180/Pi
90           DO k=0,5
91             CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ncell), bounds_lat(k,ncell))
92             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
93             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
94           ENDDO
95         ENDIF
96       ENDDO
97     ENDDO
98   ENDDO         
99
100 
101   CALL xios_set_domain_attr("i",ni_glo=ncell_tot, ibegin=displ+1, ni=ncell)
102   CALL xios_set_domain_attr("i", data_dim=1, type='unstructured' , nvertex=6)
103   CALL xios_set_domain_attr("i",lonvalue=lon, latvalue=lat, bounds_lon=bounds_lon, bounds_lat=bounds_lat)
104   
105   DEALLOCATE(lon, lat, bounds_lon, bounds_lat) 
106   
107   ncell=0
108   DO ind=1,ndomain
109     d=>domain(ind)
110       
111     DO j=d%jj_begin+1,d%jj_end
112       DO i=d%ii_begin,d%ii_end-1
113         ncell=ncell+1
114       ENDDO
115     ENDDO
116
117     DO j=d%jj_begin,d%jj_end-1
118       DO i=d%ii_begin+1,d%ii_end
119          ncell=ncell+1
120        ENDDO
121     ENDDO
122
123   ENDDO     
124   
125   ncell_v=ncell
126   
127   CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
128
129   displ=0
130   DO i=1,mpi_rank
131     displ=displ+ncell_glo(i-1)
132   ENDDO
133
134   ncell_tot=sum(ncell_glo(:))
135   
136   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:2,ncell), bounds_lat(0:2,ncell)) 
137   
138   ncell=0
139   DO ind=1,ndomain
140     d=>domain(ind)
141 
142     DO j=d%jj_begin+1,d%jj_end
143       DO i=d%ii_begin,d%ii_end-1
144           ncell=ncell+1
145           CALL xyz2lonlat(d%vertex(:,vdown,i,j),lon(ncell),lat(ncell))
146           lon(ncell)=lon(ncell)*180/Pi
147           lat(ncell)=lat(ncell)*180/Pi
148
149           CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,ncell), bounds_lat(0,ncell))
150           CALL xyz2lonlat(d%xyz(:,i,j-1),bounds_lon(1,ncell), bounds_lat(1,ncell))
151           CALL xyz2lonlat(d%xyz(:,i+1,j-1),bounds_lon(2,ncell), bounds_lat(2,ncell))
152
153           DO k=0,2
154             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
155             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
156           ENDDO
157         ENDDO
158       ENDDO 
159 
160       DO j=d%jj_begin,d%jj_end-1
161         DO i=d%ii_begin+1,d%ii_end
162           ncell=ncell+1
163           CALL xyz2lonlat(d%vertex(:,vup,i,j),lon(ncell),lat(ncell))
164           lon(ncell)=lon(ncell)*180/Pi
165           lat(ncell)=lat(ncell)*180/Pi
166           CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,ncell), bounds_lat(0,ncell))
167           CALL xyz2lonlat(d%xyz(:,i,j+1),bounds_lon(1,ncell), bounds_lat(1,ncell))
168           CALL xyz2lonlat(d%xyz(:,i-1,j+1),bounds_lon(2,ncell), bounds_lat(2,ncell))
169
170           DO k=0,2
171             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
172             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
173           ENDDO
174         ENDDO
175       ENDDO 
176       
177   ENDDO         
178
179 
180   CALL xios_set_domain_attr("v",ni_glo=ncell_tot, ibegin=displ+1, ni=ncell)
181   CALL xios_set_domain_attr("v", data_dim=1, type='unstructured' , nvertex=3)
182   CALL xios_set_domain_attr("v",lonvalue=lon, latvalue=lat, bounds_lon=bounds_lon, bounds_lat=bounds_lat)
183
184
185   dtime%second=dt
186   CALL xios_set_timestep(dtime) 
187   CALL xios_close_context_definition()
188   
189 END SUBROUTINE xios_init_write_field
190 
191 
192 SUBROUTINE xios_write_field(name,field)
193 USE field_mod
194 IMPLICIT NONE
195   CHARACTER(LEN=*),INTENT(IN) :: name
196   TYPE(t_field), POINTER :: field(:)
197   CHARACTER(LEN=10) :: str_number
198   INTEGER :: iq
199   
200   IF (Field(1)%field_type==field_T) THEN
201     IF (field(1)%ndim==2) THEN
202        CALL xios_write_field_scalar(name,field,1)
203      ELSE IF (field(1)%ndim==3) THEN
204        CALL xios_write_field_scalar(name,field,size(field(1)%rval3d,2))
205      ELSE IF (field(1)%ndim==4) THEN
206        DO iq=1,size(field(1)%rval4d,3)
207          WRITE(str_number,'(i10)') iq
208          CALL xios_write_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
209        ENDDO
210      ELSE
211        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
212      ENDIF
213    ELSE IF (Field(1)%field_type==field_Z) THEN
214     IF (field(1)%ndim==2) THEN
215        CALL xios_write_field_vort(name,field,1)
216      ELSE IF (field(1)%ndim==3) THEN
217        CALL xios_write_field_vort(name,field,size(field(1)%rval3d,2))
218      ELSE IF (field(1)%ndim==4) THEN
219        DO iq=1,size(field(1)%rval4d,3)
220          WRITE(str_number,'(i10)') iq
221          CALL xios_write_field_vort(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
222        ENDDO
223      ELSE
224        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
225      ENDIF
226    ENDIF
227     
228 END SUBROUTINE xios_write_field
229 
230 SUBROUTINE xios_write_field_scalar(name,field,nlev,iq)
231 USE genmod
232 USE mpipara
233 USE xios
234 USE grid_param
235 USE domain_mod
236 USE dimensions
237 USE spherical_geom_mod
238 USE geometry
239 USE mpi_mod
240 IMPLICIT NONE
241   CHARACTER(LEN=*),INTENT(IN) :: name
242   TYPE(t_field), POINTER :: field(:)
243   INTEGER,INTENT(IN) :: nlev
244   INTEGER,INTENT(IN),OPTIONAL :: iq
245   
246   REAL(rstd) :: field_tmp(ncell_i,nlev)
247   TYPE(t_domain),POINTER :: d
248   INTEGER :: n,i,j,ij,ind
249   
250   IF (field(1)%ndim==2) THEN
251     n=0
252     DO ind=1,ndomain
253       
254       d=>domain(ind)
255       
256       DO j=d%jj_begin,d%jj_end
257         DO i=d%ii_begin,d%ii_end
258           IF (d%own(i,j)) THEN
259             n=n+1
260             ij=d%iim*(j-1)+i
261             field_tmp(n,1)=field(ind)%rval2d(ij)
262           ENDIF
263         ENDDO
264       ENDDO
265     ENDDO
266   ELSE IF (field(1)%ndim==3) THEN
267     n=0
268     DO ind=1,ndomain
269       d=>domain(ind)
270       
271       DO j=d%jj_begin,d%jj_end
272         DO i=d%ii_begin,d%ii_end
273           IF (d%own(i,j)) THEN
274             n=n+1
275             ij=d%iim*(j-1)+i
276             field_tmp(n,:)=field(ind)%rval3d(ij,:)
277           ENDIF
278         ENDDO
279       ENDDO
280     ENDDO
281   ELSE IF (field(1)%ndim==4) THEN
282     n=0
283     DO ind=1,ndomain
284       d=>domain(ind)
285       
286       DO j=d%jj_begin,d%jj_end
287         DO i=d%ii_begin,d%ii_end
288           IF (d%own(i,j)) THEN
289             n=n+1
290             ij=d%iim*(j-1)+i
291             field_tmp(n,:)=field(ind)%rval4d(ij,:,iq)
292           ENDIF
293         ENDDO
294       ENDDO
295     ENDDO     
296   ENDIF
297   
298   CALL xios_send_field(name,field_tmp)
299 
300 END SUBROUTINE xios_write_field_scalar 
301     
302 SUBROUTINE xios_write_field_vort(name,field,nlev,iq)
303 USE genmod
304 USE mpipara
305 USE xios
306 USE grid_param
307 USE domain_mod
308 USE dimensions
309 USE spherical_geom_mod
310 USE geometry
311 USE mpi_mod
312 IMPLICIT NONE
313   CHARACTER(LEN=*),INTENT(IN) :: name
314   TYPE(t_field), POINTER :: field(:)
315   INTEGER,INTENT(IN) :: nlev
316   INTEGER,INTENT(IN),OPTIONAL :: iq
317   
318   REAL(rstd) :: field_tmp(ncell_v,nlev)
319   TYPE(t_domain),POINTER :: d
320   INTEGER :: n,i,j,ij,ind
321   
322   IF (field(1)%ndim==2) THEN
323     n=0
324     DO ind=1,ndomain
325       d=>domain(ind)
326       CALL swap_dimensions(ind) 
327       
328       DO j=d%jj_begin+1,d%jj_end
329         DO i=d%ii_begin,d%ii_end-1
330           n=n+1
331           ij=iim*(j-1)+i
332           Field_tmp(n,1)=field(ind)%rval2d(ij+z_down)
333         ENDDO
334       ENDDO
335
336       DO j=d%jj_begin,d%jj_end-1
337         DO i=d%ii_begin+1,d%ii_end
338           n=n+1
339           ij=iim*(j-1)+i
340           Field_tmp(n,1)=field(ind)%rval2d(ij+z_up)
341          ENDDO
342       ENDDO
343         
344     ENDDO
345
346   ELSE IF (field(1)%ndim==3) THEN
347     n=0
348     DO ind=1,ndomain
349       d=>domain(ind)
350       CALL swap_dimensions(ind)   
351             
352       DO j=d%jj_begin+1,d%jj_end
353         DO i=d%ii_begin,d%ii_end-1
354           n=n+1
355           ij=iim*(j-1)+i
356           Field_tmp(n,:)=field(ind)%rval3d(ij+z_down,:)
357         ENDDO
358       ENDDO
359
360       DO j=d%jj_begin,d%jj_end-1
361         DO i=d%ii_begin+1,d%ii_end
362           n=n+1
363           ij=iim*(j-1)+i
364           Field_tmp(n,:)=field(ind)%rval3d(ij+z_up,:)
365          ENDDO
366       ENDDO
367         
368     ENDDO
369
370   ELSE IF (field(1)%ndim==4) THEN
371     n=0
372     DO ind=1,ndomain
373       d=>domain(ind)
374       CALL swap_dimensions(ind) 
375               
376       DO j=d%jj_begin+1,d%jj_end
377         DO i=d%ii_begin,d%ii_end-1
378           n=n+1
379           ij=iim*(j-1)+i
380           Field_tmp(n,:)=field(ind)%rval4d(ij+z_down,:,iq)
381         ENDDO
382       ENDDO
383
384       DO j=d%jj_begin,d%jj_end-1
385         DO i=d%ii_begin+1,d%ii_end
386           n=n+1
387           ij=iim*(j-1)+i
388           Field_tmp(n,:)=field(ind)%rval4d(ij+z_up,:,iq)
389          ENDDO
390       ENDDO
391         
392     ENDDO
393
394   ENDIF
395   
396   CALL xios_send_field(name,field_tmp)
397 
398 END SUBROUTINE xios_write_field_vort 
399 
400 SUBROUTINE xios_write_field_finalize
401 IMPLICIT NONE
402   CALL xios_context_finalize
403 END SUBROUTINE xios_write_field_finalize
404   
405#else
406 
407  SUBROUTINE xios_init
408   IMPLICIT NONE
409         
410    using_xios=.FALSE.
411   
412  END SUBROUTINE xios_init
413 
414  SUBROUTINE xios_write_field(name,field)
415  USE field_mod
416  IMPLICIT NONE
417   CHARACTER(LEN=*),INTENT(IN) :: name
418   TYPE(t_field), POINTER :: field(:)
419  END SUBROUTINE xios_write_field
420 
421  SUBROUTINE xios_update_calendar(step)
422  IMPLICIT NONE
423   INTEGER, INTENT(IN):: step 
424  END SUBROUTINE xios_update_calendar
425
426  SUBROUTINE xios_write_field_finalize
427  END SUBROUTINE xios_write_field_finalize
428 
429  SUBROUTINE xios_init_write_field
430  END SUBROUTINE xios_init_write_field 
431#endif 
432 
433END MODULE xios_mod
Note: See TracBrowser for help on using the repository browser.