source: codes/icosagcm/devel/src/output/xios_mod.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: 11.4 KB
Line 
1MODULE xios_mod
2 
3#ifdef CPP_USING_XIOS
4  USE xios
5#endif
6
7  USE prec, ONLY : rstd
8  USE field_mod, ONLY : t_field, field_T, field_U, field_Z
9  USE domain_mod, ONLY : t_domain, t_cellset, domain, ndomain, mesh_loc
10  IMPLICIT NONE   
11  PRIVATE
12  SAVE
13
14  LOGICAL :: using_xios
15
16  INTEGER :: ncell_i, ncell_v, ncell_e
17!$OMP THREADPRIVATE(ncell_i, ncell_v, ncell_e)
18
19  PUBLIC :: using_xios, xios_init, &
20       xios_init_write_field,  xios_write_field_finalize, &
21       xios_write_field, xios_read_field
22
23#ifdef CPP_USING_XIOS
24
25  PUBLIC :: xios_timestep,    & 
26       xios_set_file_attr, xios_set_fieldgroup_attr, &
27       xios_set_filegroup_attr, xios_get_axis_attr, &
28       xios_send_field, xios_read_var, &
29       xios_update_calendar, xios_set_context
30 
31CONTAINS
32 
33 SUBROUTINE xios_init
34   USE mpipara, ONLY : comm_icosa
35   TYPE(xios_context) :: ctx_hdl
36
37   using_xios=.TRUE.
38   CALL xios_context_initialize("icosagcm",comm_icosa)
39   CALL xios_get_handle("icosagcm",ctx_hdl)
40   CALL xios_set_current_context(ctx_hdl)   
41
42 END SUBROUTINE xios_init
43
44 SUBROUTINE xios_init_write_field
45   USE time_mod, ONLY : dt, itau_out
46   USE grid_param, ONLY : llm, nqtot
47   USE mpi_mod, ONLY : MPI_INTEGER
48
49   TYPE(xios_context) :: ctx_hdl
50   TYPE(xios_duration)      :: dtime
51   REAL(rstd) :: lev_value(llm)
52   REAL(rstd) :: lev_valuep1(llm+1)
53   REAL(rstd) :: nq_value(nqtot)
54   INTEGER :: l, ncell, ncell_tot, displ
55   REAL(rstd),ALLOCATABLE    :: lon(:), lat(:), bounds_lon(:,:), bounds_lat(:,:)
56   INTEGER, ALLOCATABLE      :: ind_glo(:)
57   TYPE(t_domain),POINTER :: d
58   
59   !$OMP BARRIER
60   !$OMP MASTER
61   !   CALL xios_context_initialize("icosagcm",comm_icosa)
62   CALL xios_get_handle("icosagcm",ctx_hdl)
63   CALL xios_set_current_context(ctx_hdl)
64   lev_value(:) = (/ (l,l=1,llm) /)     
65   lev_valuep1(:) = (/ (l,l=1,llm+1) /)     
66   nq_value(:) = (/ (l,l=1,nqtot) /)     
67   CALL xios_set_axis_attr("lev",n_glo=llm ,value=lev_value) ;
68   CALL xios_set_axis_attr("levp1",n_glo=llm+1 ,value=lev_valuep1) ;
69   CALL xios_set_axis_attr("nq",n_glo=nqtot, value=nq_value) ;
70   
71   !------------------ primal cells ------------------
72   CALL collect_bounds(6, mesh_loc%primal_own)
73   ncell_i=ncell   
74   CALL xios_set_domaingroup_attr("i",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
75   CALL xios_set_domaingroup_attr("i", data_dim=1, type='unstructured' , nvertex=6, i_index=ind_glo)
76   CALL xios_set_domaingroup_attr("i",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
77   DEALLOCATE(lon, lat, bounds_lon, bounds_lat,ind_glo) 
78   
79   !--------------------- dual cells ------------------
80   
81   CALL collect_bounds(3, mesh_loc%dual_own)
82   ncell_v=ncell
83   CALL xios_set_domain_attr("v",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
84   CALL xios_set_domain_attr("v", data_dim=1, type='unstructured' , nvertex=3)
85   CALL xios_set_domain_attr("v",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
86   DEALLOCATE(lon, lat, bounds_lon, bounds_lat,ind_glo) 
87   
88   !---------------------- edges -----------------------
89   
90   CALL collect_bounds(2, mesh_loc%edge_own)
91   ncell_e=ncell
92   CALL xios_set_domain_attr("u",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
93   CALL xios_set_domain_attr("u", data_dim=1, type='unstructured' , nvertex=2, i_index=ind_glo)
94   CALL xios_set_domain_attr("u",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
95   DEALLOCATE(lon, lat, bounds_lon, bounds_lat,ind_glo) 
96   
97   dtime%second=dt
98   CALL xios_set_timestep(dtime)
99   
100   CALL xios_set_fieldgroup_attr("standard_output", freq_op=itau_out*xios_timestep, freq_offset=(itau_out-1)*xios_timestep)
101   
102   CALL xios_close_context_definition()
103   !$OMP END MASTER
104   !$OMP BARRIER
105   
106 CONTAINS
107   
108   SUBROUTINE collect_bounds(nvert, cells)
109     USE mpipara, ONLY : comm_icosa, mpi_size, mpi_rank
110     INTEGER, INTENT(IN) :: nvert
111     TYPE(t_cellset)     :: cells(:)
112     INTEGER :: i, ind, n_beg, n_end, ierr, ncell_glo(0:mpi_size-1)
113     ncell = SUM(cells%ncell)
114     CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER, &
115          ncell_glo,1, MPI_INTEGER, comm_icosa, ierr)
116     displ=0
117     DO i=1,mpi_rank
118        displ=displ+ncell_glo(i-1)
119     ENDDO
120     ncell_tot=sum(ncell_glo(:))
121     
122     ALLOCATE(lon(ncell), lat(ncell), ind_glo(ncell))
123     ALLOCATE(bounds_lon(nvert,ncell), bounds_lat(nvert,ncell))
124     
125     n_beg=0
126     DO ind=1,ndomain
127        n_end = n_beg + cells(ind)%ncell
128        ind_glo(n_beg+1:n_end) = cells(ind)%ind_glo(:)
129        lon(n_beg+1:n_end) = cells(ind)%lon(:)
130        lat(n_beg+1:n_end) = cells(ind)%lat(:)
131        bounds_lon(:,n_beg+1:n_end) = cells(ind)%bnds_lon(:,:)
132        bounds_lat(:,n_beg+1:n_end) = cells(ind)%bnds_lat(:,:)
133        n_beg = n_end
134     END DO
135   END SUBROUTINE collect_bounds
136   
137 END SUBROUTINE xios_init_write_field
138 
139 SUBROUTINE xios_write_field(name,field)
140   CHARACTER(LEN=*),INTENT(IN) :: name
141   TYPE(t_field), POINTER :: field(:)
142   TYPE(t_cellset), POINTER :: cells(:)
143   INTEGER :: ncells
144
145!$OMP BARRIER
146!$OMP MASTER
147
148   SELECT CASE(field(1)%field_type)
149   CASE(field_T)
150      cells => mesh_loc%primal_own
151      ncells = ncell_i
152   CASE(field_U)
153      cells => mesh_loc%edge_own
154      ncells = ncell_e
155   CASE(field_Z)
156      cells => mesh_loc%dual_own
157      ncells = ncell_v
158   END SELECT
159
160   IF (field(1)%ndim>4) THEN
161      PRINT *, "xios_write_field : dimension > 4 are not supported for now"
162   ELSE
163      CALL xios_write_field_hex(name, field, cells, & 
164           ncells, field(1)%dim3, field(1)%dim4)
165   END IF
166   
167!$OMP END MASTER
168!$OMP BARRIER
169     
170 END SUBROUTINE xios_write_field
171
172 SUBROUTINE xios_read_field(name,field)
173   CHARACTER(LEN=*),INTENT(IN) :: name
174   TYPE(t_field), POINTER :: field(:)
175   TYPE(t_cellset), POINTER :: cells(:)
176   INTEGER :: ncells
177
178!$OMP BARRIER
179!$OMP MASTER
180
181   SELECT CASE(field(1)%field_type)
182   CASE(field_T)
183      cells => mesh_loc%primal_own
184      ncells = ncell_i
185   CASE(field_U)
186      cells => mesh_loc%edge_own
187      ncells = ncell_e
188   CASE(field_Z)
189      cells => mesh_loc%dual_own
190      ncells = ncell_v
191   END SELECT
192
193   IF (field(1)%ndim>4) THEN
194      PRINT *, "xios_read_field : dimension > 4 are not supported for now"
195   ELSE
196      CALL xios_read_field_hex(name, field, cells, & 
197           ncells, field(1)%dim3, field(1)%dim4)
198   END IF
199   
200!$OMP END MASTER
201!$OMP BARRIER
202     
203 END SUBROUTINE xios_read_field
204
205 SUBROUTINE xios_write_field_hex(name, field, cells, ncell_tot, nlev, nq)
206   CHARACTER(LEN=*),INTENT(IN) :: name
207   TYPE(t_field) :: field(:)
208   TYPE(t_cellset), TARGET :: cells(:)
209   INTEGER,INTENT(IN) :: ncell_tot, nlev, nq
210
211   REAL(rstd) :: field_tmp(ncell_tot,nlev,nq)
212   TYPE(t_cellset), POINTER :: cellset
213   INTEGER :: ind, n_beg, n_end, n, ij, sgn
214   LOGICAL :: signed
215
216   IF(ALLOCATED(cells(1)%sgn)) THEN
217      signed=.TRUE.
218   ELSE
219      signed=.FALSE.
220      sgn=1
221   END IF
222
223   n_beg=0
224   DO ind=1,ndomain
225      cellset => cells(ind)
226      n_end = n_beg + cellset%ncell
227      DO n=1, cellset%ncell
228         ij = cellset%ij(n)
229         IF(signed) sgn = cellset%sgn(n)
230         SELECT CASE(field(1)%ndim)
231         CASE(2)
232            field_tmp(n_beg+n,1,1) = sgn*field(ind)%rval2d(ij)
233         CASE(3)
234            field_tmp(n_beg+n,:,1) = sgn*field(ind)%rval3d(ij,:)
235         CASE(4)
236            field_tmp(n_beg+n,:,:) = sgn*field(ind)%rval4d(ij,:,:)
237         END SELECT
238      END DO
239   END DO
240   CALL xios_send_field(name,field_tmp) 
241 END SUBROUTINE xios_write_field_hex
242
243SUBROUTINE xios_read_field_hex(name, field, cells, ncell_tot, nlev, nq)
244   CHARACTER(LEN=*),INTENT(IN) :: name
245   TYPE(t_field) :: field(:)
246   TYPE(t_cellset), TARGET :: cells(:)
247   INTEGER,INTENT(IN) :: ncell_tot, nlev, nq
248
249   REAL(rstd) :: field_tmp(ncell_tot,nlev,nq)
250   TYPE(t_cellset), POINTER :: cellset
251   INTEGER :: ind, n_beg, n_end, n, ij, sgn
252   LOGICAL :: signed
253
254   CALL xios_recv_field(name,field_tmp)
255
256   IF(ALLOCATED(cells(1)%sgn)) THEN
257      signed=.TRUE.
258   ELSE
259      signed=.FALSE.
260      sgn=1
261   END IF
262
263   n_beg=0
264   DO ind=1,ndomain
265      cellset => cells(ind)
266      n_end = n_beg + cellset%ncell
267      DO n=1, cellset%ncell
268         ij = cellset%ij(n)
269         IF(signed) sgn = cellset%sgn(n)
270         SELECT CASE(field(1)%ndim)
271         CASE(2)
272            field(ind)%rval2d(ij) = sgn*field_tmp(n_beg+n,1,1) 
273         CASE(3)
274            field(ind)%rval3d(ij,:) = sgn*field_tmp(n_beg+n,:,1)
275         CASE(4)
276            field(ind)%rval4d(ij,:,:) = sgn*field_tmp(n_beg+n,:,:)
277         END SELECT
278      END DO
279   END DO
280 END SUBROUTINE xios_read_field_hex
281
282 SUBROUTINE xios_read_var(name,field)
283   USE prec
284   USE transfert_mod
285   CHARACTER(LEN=*),INTENT(IN) :: name
286   REAL(rstd), INTENT(OUT) :: field
287   !$OMP MASTER
288   CALL xios_recv_field(name,field)
289   !$OMP END MASTER
290   CALL bcast_omp(field)
291 END SUBROUTINE
292 
293 SUBROUTINE xios_write_field_finalize
294!$OMP BARRIER
295!$OMP MASTER
296   CALL xios_context_finalize
297!$OMP END MASTER
298!$OMP BARRIER
299 END SUBROUTINE xios_write_field_finalize
300
301 SUBROUTINE xios_set_context
302  TYPE(xios_context) :: ctx_hdl
303
304!$OMP MASTER
305   CALL xios_get_handle("icosagcm",ctx_hdl)
306   CALL xios_set_current_context(ctx_hdl)
307!$OMP END MASTER
308
309  END SUBROUTINE xios_set_context
310
311
312#else
313 
314
315INTERFACE xios_send_field
316  MODULE PROCEDURE xios_send_field_scalar, xios_send_field_1d
317END INTERFACE  xios_send_field
318
319INTEGER,PARAMETER :: xios_timestep=1
320
321CONTAINS 
322 
323 
324  SUBROUTINE xios_init
325    using_xios=.FALSE.   
326  END SUBROUTINE xios_init
327 
328  SUBROUTINE xios_send_field_scalar(name,field)
329    CHARACTER(LEN=*),INTENT(IN) :: name
330    REAL,INTENT(IN) :: field
331  END SUBROUTINE xios_send_field_scalar 
332
333  SUBROUTINE xios_send_field_1d(name,field)
334    CHARACTER(LEN=*),INTENT(IN) :: name
335    REAL,INTENT(IN) :: field(:)
336  END SUBROUTINE xios_send_field_1d 
337 
338  SUBROUTINE xios_write_field(name,field)
339  USE field_mod
340   CHARACTER(LEN=*),INTENT(IN) :: name
341   TYPE(t_field), POINTER :: field(:)
342  END SUBROUTINE xios_write_field
343
344  SUBROUTINE xios_read_field(name,field)
345  USE field_mod
346   CHARACTER(LEN=*),INTENT(IN) :: name
347   TYPE(t_field), POINTER :: field(:)
348  END SUBROUTINE xios_read_field
349
350 SUBROUTINE xios_read_var(name,field)
351   USE prec
352   CHARACTER(LEN=*),INTENT(IN) :: name
353   REAL(rstd), INTENT(OUT) :: field
354 END SUBROUTINE
355 
356  SUBROUTINE xios_update_calendar(step)
357   INTEGER, INTENT(IN):: step 
358  END SUBROUTINE xios_update_calendar
359
360  SUBROUTINE xios_write_field_finalize
361  END SUBROUTINE xios_write_field_finalize
362 
363  SUBROUTINE xios_init_write_field
364  END SUBROUTINE xios_init_write_field 
365 
366  SUBROUTINE xios_set_context
367  END SUBROUTINE xios_set_context
368 
369  SUBROUTINE xios_set_fieldgroup_attr(name,enabled,freq_op)
370    CHARACTER(LEN=*) :: name
371    LOGICAL,OPTIONAL          :: enabled
372    INTEGER,OPTIONAL          :: freq_op
373  END SUBROUTINE xios_set_fieldgroup_attr
374
375  SUBROUTINE xios_set_filegroup_attr(name,enabled)
376    CHARACTER(LEN=*) :: name
377    LOGICAL,OPTIONAL          :: enabled
378  END SUBROUTINE xios_set_filegroup_attr
379
380  SUBROUTINE xios_set_file_attr(id,name,mode,enabled, output_freq)
381    CHARACTER(LEN=*) :: id
382    CHARACTER(LEN=*),OPTIONAL :: name, mode
383    LOGICAL,OPTIONAL          :: enabled
384    INTEGER,OPTIONAL          :: output_freq
385  END SUBROUTINE xios_set_file_attr
386
387  SUBROUTINE xios_get_axis_attr(name,n_glo,value)
388    CHARACTER(LEN=*) :: name
389    INTEGER,OPTIONAL          :: n_glo
390    REAL,OPTIONAL             :: value(:)
391  END SUBROUTINE xios_get_axis_attr
392
393  SUBROUTINE xios_set_axis_attr(id,n_glo,value)
394    CHARACTER(LEN=*) :: id
395    INTEGER,OPTIONAL          :: n_glo
396    REAL,OPTIONAL             :: value(:)
397  END SUBROUTINE xios_set_axis_attr
398
399#endif 
400
401END MODULE xios_mod
Note: See TracBrowser for help on using the repository browser.