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

Last change on this file since 370 was 342, checked in by dubos, 9 years ago

Minor Fix
File size: 11.4 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
10  INTEGER,SAVE :: ncell_i
11!$OMP THREADPRIVATE(ncell_i)
12  INTEGER,SAVE :: ncell_v
13!$OMP THREADPRIVATE(ncell_v)
14
15  PRIVATE ncell_i,ncell_v
16 
17CONTAINS
18
19#ifdef CPP_USING_XIOS
20 
21 SUBROUTINE xios_init
22   USE getin_mod
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
51!$OMP BARRIER
52!$OMP MASTER
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_valuep1) ;
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()
193!$OMP END MASTER
194!$OMP BARRIER
195   
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
206
207!$OMP BARRIER
208!$OMP MASTER
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
237!$OMP END MASTER
238!$OMP BARRIER
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
265       
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)
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
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
348       DO j=d%jj_begin,d%jj_end-1
349         DO i=d%ii_begin+1,d%ii_end
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)
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
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
372       DO j=d%jj_begin,d%jj_end-1
373         DO i=d%ii_begin+1,d%ii_end
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)
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
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
396       DO j=d%jj_begin,d%jj_end-1
397         DO i=d%ii_begin+1,d%ii_end
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
414
415!$OMP BARRIER
416!$OMP MASTER
417   CALL xios_context_finalize
418!$OMP END MASTER
419!$OMP BARRIER
420
421 END SUBROUTINE xios_write_field_finalize
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
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 
459 
460  SUBROUTINE xios_set_context
461  END SUBROUTINE xios_set_context
462 
463
464#endif 
465 
466END MODULE xios_mod
Note: See TracBrowser for help on using the repository browser.