source: codes/icosagcm/devel/src/output/xios_mod.F90 @ 886

Last change on this file since 886 was 886, checked in by jisesh, 5 years ago

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