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

Last change on this file since 295 was 266, checked in by ymipsl, 10 years ago

Synchronize trunk and Saturn branch.
Merge modification from Saturn branch to trunk

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