Ticket #72: test_client.f90

File test_client.f90, 1.6 KB (added by rlacroix, 8 years ago)
Line 
1PROGRAM test_client
2  USE xios
3  IMPLICIT NONE
4  INCLUDE "mpif.h"
5  INTEGER :: ierr, rank, size
6  INTEGER :: comm
7  TYPE(xios_context) :: ctx_hdl
8  INTEGER,PARAMETER :: ni=50
9  INTEGER,PARAMETER :: nj=50
10  DOUBLE PRECISION :: field(ni,nj)
11  INTEGER :: i,ni_glo,ibegin,nj_glo,jbegin
12
13  ! Initialize MPI
14  call MPI_INIT(ierr)
15
16  ! Initialize XIOS
17  call xios_initialize('client', return_comm=comm)
18
19  ! Initialize the context
20  call xios_context_initialize('test', comm)
21  call xios_get_handle('test', ctx_hdl)
22  call xios_set_current_context(ctx_hdl)
23
24  ! This is quick and dirty but it doesn't matter
25  call MPI_COMM_SIZE(comm, size, ierr) ! sqrt(size) must be an integer but the check is skipped on purpose
26  call MPI_COMM_RANK(comm, rank, ierr)
27  ibegin = (rank/2) * ni
28  jbegin = MOD(rank,2) * nj
29  ni_glo = int(sqrt(real(size))) * ni
30  nj_glo = int(sqrt(real(size))) * nj
31
32  if (rank == 0) print *, ni_glo, ni, nj_glo, nj
33
34  ! Initialize the grid
35  call xios_set_axis_attr('x', n_glo=ni_glo, n=ni, begin=ibegin, value=(/(real(i,kind=8), i=ibegin,ibegin+ni-1)/))
36  call xios_set_axis_attr('y', n_glo=nj_glo, n=nj, begin=jbegin, value=(/(real(i,kind=8), i=jbegin,jbegin+nj-1)/))
37
38  ! Initialize the output frequency
39  call xios_set_file_attr('output', output_freq=xios_timestep)
40
41  ! Finalize the initialization
42  call xios_close_context_definition()
43
44  ! Send a field to trigger the crash
45  call xios_update_calendar(1)
46  field = rank
47  call xios_send_field('field', field)
48
49  ! Clean-ups
50  call xios_context_finalize()
51  call MPI_COMM_FREE(comm, ierr)
52  call xios_finalize()
53
54  call MPI_FINALIZE(ierr)
55
56END PROGRAM test_client
57
58
59
60
61