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

Last change on this file since 238 was 186, checked in by ymipsl, 10 years ago

Add new openMP parallelism based on distribution of domains on threads. There is no more limitation of number of threads by MPI process.

YM
File size: 11.1 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_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()
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#else
424 
425  SUBROUTINE xios_init
426   IMPLICIT NONE
427         
428    using_xios=.FALSE.
429   
430  END SUBROUTINE xios_init
431 
432  SUBROUTINE xios_write_field(name,field)
433  USE field_mod
434  IMPLICIT NONE
435   CHARACTER(LEN=*),INTENT(IN) :: name
436   TYPE(t_field), POINTER :: field(:)
437  END SUBROUTINE xios_write_field
438 
439  SUBROUTINE xios_update_calendar(step)
440  IMPLICIT NONE
441   INTEGER, INTENT(IN):: step 
442  END SUBROUTINE xios_update_calendar
443
444  SUBROUTINE xios_write_field_finalize
445  END SUBROUTINE xios_write_field_finalize
446 
447  SUBROUTINE xios_init_write_field
448  END SUBROUTINE xios_init_write_field 
449#endif 
450 
451END MODULE xios_mod
Note: See TracBrowser for help on using the repository browser.