source: XIOS/trunk/src/test/test_new_features.f90 @ 549

Last change on this file since 549 was 549, checked in by rlacroix, 9 years ago

Revised calendar functionalities:

  • the calendar is now configured from a specific calendar child node of the context in the XML configuration file. Example: <calendar type="Gregorian" start_date="2012-03-01 15:00:00" time_origin="2012-02-29 15:00:00" timestep="1h" />
  • the calendar type should now be configured when defining the start time and/or the time origin.
  • the start time and the time origin are now optional, 0000-01-01 00:00:00 will be used by default. It is also possible to define them partially. For example, 2015 and 2014-12 are valid dates corresponding respectively to 2015-01-01 00:00:00 and 2014-12-01 00:00:00.
  • an optional duration offset can be added to the start date and time origin. For example, it's possible to define the date 2015-01-12 12:00:00 as 2015-01-11 + 36h or 2015-01-11 12:00:00 + 1d. The duration format is the same as the time step. Being that the date is optional, it is possible to only use a duration (for example + 42s is the same as 0000-01-01 00:00:00 + 42s). An error will be raised if a duration based on the time step is used before the time step was configured. For example, the following would cause an error: <calendar type="Gregorian" start_date="+ 1ts" /> but <calendar type="Gregorian" start_date="+ 1ts" timestep="0.5h" /> would not.
  • new Fortran interface to define the calendar:
    • xios_define_calendar(type[, timestep, start_date, time_origin]) will create a calendar when none had previously been defined. Only the type argument is mandatory, the rest is optional. Calendar operations on dates and durations are possible as soon as the calendar is created (either using this procedure or directly from the XML configuration file).
    • the following getter and setter procedures are available: xios_set_timestep, xios_set_start_date, xios_set_time_origin, xios_get_calendar_type, xios_get_timestep, xios_get_start_date, xios_get_time_origin.
  • new Fortran interface to interact with the calendar: xios_update_calendar, xios_get_current_date, xios_get_year_length_in_seconds, xios_get_day_length_in_seconds.
  • new Fortran interface for date conversion: xios_date_get_second_of_year, xios_date_get_day_of_year, xios_date_get_fraction_of_year, xios_date_get_second_of_day, xios_date_get_fraction_of_day.
  • two new placeholders are available to format the file name when splitting the output (split_freq_format attribute):
    • %S the number of seconds since the time origin
    • %D the integral number of days since the time origin
File size: 3.7 KB
Line 
1PROGRAM test_new_features
2
3  USE xios
4  USE mod_wait
5  IMPLICIT NONE
6  INCLUDE "mpif.h"
7  INTEGER :: rank
8  INTEGER :: size
9  INTEGER :: ierr
10
11  CHARACTER(len=*),PARAMETER :: id="client"
12  INTEGER :: comm
13  TYPE(xios_duration)      :: dtime
14  TYPE(xios_context) :: ctx_hdl
15  INTEGER,PARAMETER :: ni_glo=100
16  INTEGER,PARAMETER :: nj_glo=100
17  INTEGER,PARAMETER :: llm=5
18  DOUBLE PRECISION  :: lval(llm)=1
19  DOUBLE PRECISION  :: lval2(llm)=1
20  TYPE(xios_field) :: field_hdl
21  TYPE(xios_fieldgroup) :: fieldgroup_hdl
22  TYPE(xios_file) :: file_hdl
23  LOGICAL :: ok
24
25  DOUBLE PRECISION,DIMENSION(ni_glo,nj_glo) :: lon_glo,lat_glo
26!  DOUBLE PRECISION :: field_A_glo(ni_glo,nj_glo,llm,llm)
27!  DOUBLE PRECISION,ALLOCATABLE :: lon(:,:),lat(:,:),field_A(:,:,:,:), lonvalue(:) ;
28  DOUBLE PRECISION :: field_A_glo(ni_glo,nj_glo,llm)
29  DOUBLE PRECISION,ALLOCATABLE :: lon(:,:),lat(:,:),field_A(:,:,:), lonvalue(:) ;
30  INTEGER :: ni,ibegin,iend,nj,jbegin,jend
31  INTEGER :: i,j,l,ts,n,k
32
33!!! MPI Initialization
34
35  CALL MPI_INIT(ierr)
36
37  CALL init_wait
38
39!!! XIOS Initialization (get the local communicator)
40
41  CALL xios_initialize(id,return_comm=comm)
42
43  CALL MPI_COMM_RANK(comm,rank,ierr)
44  CALL MPI_COMM_SIZE(comm,size,ierr)
45
46  DO j=1,nj_glo
47    DO i=1,ni_glo
48      lon_glo(i,j)=(i-1)+(j-1)*ni_glo
49      lat_glo(i,j)=1000+(i-1)+(j-1)*ni_glo
50      DO l=1,llm
51!        DO k=1,llm
52!          field_A_glo(i,j,l,k)=(i-1)+(j-1)*ni_glo+10000*l+100000*k
53!        ENDDO
54        field_A_glo(i,j,l)=(i-1)+(j-1)*ni_glo+10000*l
55      ENDDO
56    ENDDO
57  ENDDO
58  ni=ni_glo ; ibegin=1
59
60  jbegin=1
61  DO n=0,size-1
62    nj=nj_glo/size
63    IF (n<MOD(nj_glo,size)) nj=nj+1
64    IF (n==rank) exit
65    jbegin=jbegin+nj
66  ENDDO
67
68  iend=ibegin+ni-1 ; jend=jbegin+nj-1
69
70  ALLOCATE(lon(ni,nj),lat(ni,nj),field_A(0:ni+1,-1:nj+2,llm),lonvalue(ni*nj))
71! ALLOCATE(lon(ni,nj),lat(ni,nj),field_A(0:ni+1,-1:nj+2,llm,llm),lonvalue(ni*nj))
72  lon(:,:)=lon_glo(ibegin:iend,jbegin:jend)
73  lat(:,:)=lat_glo(ibegin:iend,jbegin:jend)
74  field_A(1:ni,1:nj,:)=field_A_glo(ibegin:iend,jbegin:jend,:)
75
76  CALL xios_context_initialize("test",comm)
77  CALL xios_get_handle("test",ctx_hdl)
78  CALL xios_set_current_context(ctx_hdl)
79
80! CALL xios_define_calendar(type="Gregorian")
81  CALL xios_set_axis_attr("axis_A",size=llm ,value=lval) ;
82! CALL xios_set_axis_attr("axis_B",size=llm ,value=lval2) ;
83  CALL xios_set_domain_attr("domain_A",ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, ni=ni,jbegin=jbegin,nj=nj)
84  CALL xios_set_domain_attr("domain_A",data_dim=2, data_ibegin=-1, data_ni=ni+2, data_jbegin=-2, data_nj=nj+4)
85  CALL xios_set_domain_attr("domain_A",lonvalue=RESHAPE(lon,(/ni*nj/)),latvalue=RESHAPE(lat,(/ni*nj/)))
86  CALL xios_set_fieldgroup_attr("field_definition",enabled=.TRUE.)
87
88  CALL xios_get_handle("field_definition",fieldgroup_hdl)
89  CALL xios_add_child(fieldgroup_hdl,field_hdl,"field_B")
90  CALL xios_set_attr(field_hdl,field_ref="field_A",name="field_B")
91
92  CALL xios_get_handle("output",file_hdl)
93  CALL xios_add_child(file_hdl,field_hdl)
94  CALL xios_set_attr(field_hdl,field_ref="field_A",name="field_C")
95
96
97    dtime%second=3600
98!   CALL xios_set_timestep(timestep=dtime)
99
100    ni=0 ; lonvalue(:)=0
101    CALL xios_get_domain_attr("domain_A",ni=ni,lonvalue=lonvalue)
102
103    print *,"ni",ni
104    print *,"lonvalue",lonvalue ;
105
106    CALL xios_is_defined_field_attr("field_A",enabled=ok)
107    PRINT *,"field_A : attribute enabled is defined ? ",ok
108    CALL xios_close_context_definition()
109
110    PRINT*,"field field_A is active ? ",xios_field_is_active("field_A")
111    DO ts=1,24*10
112      CALL xios_update_calendar(ts)
113      CALL xios_send_field("field_A",field_A)
114      CALL wait_us(5000) ;
115    ENDDO
116
117    CALL xios_context_finalize()
118    CALL xios_finalize()
119
120  CALL MPI_FINALIZE(ierr)
121
122END PROGRAM test_new_features
123
124
125
126
127
Note: See TracBrowser for help on using the repository browser.