source: XIOS/trunk/src/test/test_complete.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
  • Property copyright set to
    Software name : XIOS (Xml I/O Server)
    http://forge.ipsl.jussieu.fr/ioserver
    Creation date : January 2009
    Licence : CeCCIL version2
    see license file in root directory : Licence_CeCILL_V2-en.txt
    or http://www.cecill.info/licences/Licence_CeCILL_V2-en.html
    Holder : CEA/LSCE (Laboratoire des Sciences du CLimat et de l'Environnement)
    CNRS/IPSL (Institut Pierre Simon Laplace)
    Project Manager : Yann Meurdesoif
    yann.meurdesoif@cea.fr
File size: 8.0 KB
Line 
1PROGRAM test_complete
2
3  USE xios
4  USE mod_wait
5  IMPLICIT NONE
6  INCLUDE "mpif.h"
7  INTEGER :: rank
8  INTEGER :: size_loc
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  TYPE(xios_field) :: field_hdl
20  TYPE(xios_fieldgroup) :: fieldgroup_hdl
21  TYPE(xios_file) :: file_hdl
22  LOGICAL :: ok
23  CHARACTER(len=256) :: crname
24
25  DOUBLE PRECISION,DIMENSION(ni_glo,nj_glo) :: lon_glo,lat_glo
26  DOUBLE PRECISION :: field_A_glo(ni_glo,nj_glo,llm)
27  DOUBLE PRECISION,ALLOCATABLE :: lon(:,:),lat(:,:),field_A_atm(:,:,:), field_A_srf(:,:), lonvalue(:)
28  INTEGER, ALLOCATABLE :: kindex(:)
29  INTEGER :: ni,ibegin,iend,nj,jbegin,jend
30  INTEGER :: i,j,l,ts,n, nb_pt
31
32!!! MPI Initialization
33
34  CALL MPI_INIT(ierr)
35
36  CALL init_wait
37
38!!! XIOS Initialization (get the local communicator)
39
40  CALL xios_initialize(id,return_comm=comm)
41
42  CALL MPI_COMM_RANK(comm,rank,ierr)
43  CALL MPI_COMM_SIZE(comm,size_loc,ierr)
44
45
46!###########################################################################
47! Contexte ATM
48!###########################################################################
49
50!!! Initialisation des coordonnées globales et locales pour la grille réguliÚre
51
52  DO j=1,nj_glo
53    DO i=1,ni_glo
54      lon_glo(i,j)=(i-1)+(j-1)*ni_glo
55      lat_glo(i,j)=1000+(i-1)+(j-1)*ni_glo
56      DO l=1,llm
57        field_A_glo(i,j,l)=(i-1)+(j-1)*ni_glo+10000*l
58      ENDDO
59    ENDDO
60  ENDDO
61  ni=ni_glo ; ibegin=1
62
63  jbegin=1
64  DO n=0,size_loc-1
65    nj=nj_glo/size_loc
66    IF (n<MOD(nj_glo,size_loc)) nj=nj+1
67    IF (n==rank) exit
68    jbegin=jbegin+nj
69  ENDDO
70
71  iend=ibegin+ni-1 ; jend=jbegin+nj-1
72
73  ALLOCATE(lon(ni,nj),lat(ni,nj),field_A_atm(0:ni+1,-1:nj+2,llm),lonvalue(ni*nj))
74  lon(:,:)=lon_glo(ibegin:iend,jbegin:jend)
75  lat(:,:)=lat_glo(ibegin:iend,jbegin:jend)
76  field_A_atm(1:ni,1:nj,:)=field_A_glo(ibegin:iend,jbegin:jend,:)
77
78
79!!! Context ATMOSPHERE
80
81  CALL xios_context_initialize("atmosphere",comm)
82  CALL xios_get_handle("atmosphere",ctx_hdl)
83  CALL xios_set_current_context(ctx_hdl)
84
85  CALL xios_define_calendar(type="Gregorian", &
86                            start_date=xios_date(2000, 01, 01, 00, 00, 00), &
87                            time_origin=xios_date(1999, 01, 01, 15, 00, 00))
88
89  CALL xios_set_axis_attr("axis_atm",size=llm ,value=lval) ;
90
91  CALL xios_set_domain_attr("domain_atm",ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, ni=ni,jbegin=jbegin,nj=nj)
92  CALL xios_set_domain_attr("domain_atm",data_dim=2, data_ibegin=-1, data_ni=ni+2, data_jbegin=-2, data_nj=nj+4)
93  CALL xios_set_domain_attr("domain_atm",lonvalue=RESHAPE(lon,(/ni*nj/)),latvalue=RESHAPE(lat,(/ni*nj/)))
94
95  CALL xios_set_domain_attr("domain_atm_zoom",ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, ni=ni,jbegin=jbegin,nj=nj)
96  CALL xios_set_domain_attr("domain_atm_zoom",data_dim=2, data_ibegin=-1, data_ni=ni+2, data_jbegin=-2, data_nj=nj+4)
97  CALL xios_set_domain_attr("domain_atm_zoom",lonvalue=RESHAPE(lon,(/ni*nj/)),latvalue=RESHAPE(lat,(/ni*nj/)))
98
99!!! Activation du groupe field_definition
100
101  CALL xios_set_fieldgroup_attr("field_definition",enabled=.TRUE.)
102
103!!! Création d un nouveau champ
104
105  CALL xios_get_handle("field_definition",fieldgroup_hdl)
106  CALL xios_add_child(fieldgroup_hdl,field_hdl,"field_B_atm")
107
108!!! Heritage des attributs d un autre champ
109
110  CALL xios_set_attr(field_hdl,field_ref="field_A_atm",name="field_B_atm")
111
112!!! Affectation de ce nouveau champ au fichier avec un nouveau nom
113
114  CALL xios_get_handle("output_atmosphere",file_hdl)
115  CALL xios_add_child(file_hdl,field_hdl)
116  CALL xios_set_attr(field_hdl,field_ref="field_B_atm",name="field_C_atm")
117
118!!! Definition du timestep
119
120  dtime%second=3600
121  CALL xios_set_timestep(timestep=dtime)
122
123!!! Recupration des valeurs des longitudes et de taille des domaines locaux (pour test de fonctionnalité)
124
125  ni=0 ; lonvalue(:)=0
126  CALL xios_get_domain_attr("domain_atm",ni=ni,lonvalue=lonvalue)
127
128  PRINT *,"ni",ni
129  PRINT *,"lonvalue",lonvalue ;
130
131!!! Fin de la definition du contexte
132
133  CALL xios_close_context_definition()
134
135!!! Test des valeurs des champs/fichiers
136
137  !!! Attribut defini ?
138
139  CALL xios_is_defined_field_attr("field_A_atm",enabled=ok)
140  PRINT *,"field_A_atm : attribute enabled is defined ? ",ok
141
142  !!! Recuperer la valeur d un attribut
143
144  CALL xios_get_field_attr("field_A_atm",name=crname)
145  PRINT *,"field_A_atm : attribute name is : ",TRIM(crname)
146
147  !!! Champ actif (besoin de fournir la valeur) ?
148
149    PRINT*,"field field_A_atm is active ? ",xios_field_is_active("field_A_atm")
150
151  !!! Champ defini ?
152
153    PRINT*,"field field_A_atm is valid ?",xios_is_valid_field("field_A_atm")
154
155
156!###########################################################################
157! Contexte SRF
158!###########################################################################
159
160!!! Initialisation des coordonnées globales et locales pour la grille indexee (1 point sur 2)
161
162    nb_pt=ni*nj/2
163    ALLOCATE(kindex(nb_pt),field_A_srf(nb_pt,llm))
164    DO i=1,nb_pt
165      kindex(i)=2*i-1
166    ENDDO
167    field_A_srf(1:nb_pt,:)=RESHAPE(field_A_glo(ibegin:iend:2,jbegin:jend,:),(/ nb_pt,llm /))
168
169  CALL xios_context_initialize("surface",comm)
170  CALL xios_get_handle("surface",ctx_hdl)
171  CALL xios_set_current_context(ctx_hdl)
172
173  CALL xios_define_calendar(type="Gregorian", &
174                            start_date=xios_date(2000, 01, 01, 00, 00, 00), &
175                            time_origin=xios_date(1999, 01, 01, 15, 00, 00))
176
177  CALL xios_set_axis_attr("axis_srf",size=llm ,value=lval) ;
178  CALL xios_set_domain_attr("domain_srf",ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, ni=ni,jbegin=jbegin,nj=nj)
179  CALL xios_set_domain_attr("domain_srf",data_dim=1, data_ibegin=0, data_ni=nb_pt)
180  CALL xios_set_domain_attr("domain_srf",data_n_index=nb_pt, data_i_index=kindex)
181  CALL xios_set_domain_attr("domain_srf",lonvalue=RESHAPE(lon,(/ni*nj/)),latvalue=RESHAPE(lat,(/ni*nj/)))
182
183!!! Création d un nouveau champ
184
185  CALL xios_get_handle("field_definition",fieldgroup_hdl)
186  CALL xios_add_child(fieldgroup_hdl,field_hdl,"field_B_srf")
187
188!!! Heritage des attributs d un autre champ
189
190  CALL xios_set_attr(field_hdl,field_ref="field_A_srf",name="field_B_srf")
191
192!!! Affectation de ce nouveau champ au fichier avec un nouveau nom
193
194  CALL xios_get_handle("output_surface",file_hdl)
195  CALL xios_add_child(file_hdl,field_hdl)
196  CALL xios_set_attr(field_hdl,field_ref="field_B_srf",name="field_C_srf")
197
198!!! Definition du timestep
199
200  dtime%second=1800
201  CALL xios_set_timestep(timestep=dtime)
202
203!!! Recupration des valeurs des longitudes et de taille des domaines locaux (pour test de fonctionnalité)
204
205  ni=0 ; lonvalue(:)=0
206  CALL xios_get_domain_attr("domain_srf",ni=ni,lonvalue=lonvalue)
207
208  PRINT *,"ni",ni
209  PRINT *,"lonvalue",lonvalue ;
210
211!!! Fin de la definition du contexte SRF
212
213  CALL xios_close_context_definition()
214
215
216!####################################################################################
217!!! Boucle temporelle
218!####################################################################################
219
220    DO ts=1,24*10
221
222      CALL xios_get_handle("atmosphere",ctx_hdl)
223      CALL xios_set_current_context(ctx_hdl)
224
225!!! Mise a jour du pas de temps
226
227      CALL xios_update_calendar(ts)
228
229!!! On donne la valeur du champ atm
230
231      CALL xios_send_field("field_A_atm",field_A_atm)
232
233!!! On change de contexte
234
235      CALL xios_get_handle("surface",ctx_hdl)
236      CALL xios_set_current_context(ctx_hdl)
237
238!!! Mise a jour du pas de temps
239
240      CALL xios_update_calendar(ts)
241
242!!! On donne la valeur du champ srf
243
244      CALL xios_send_field("field_A_srf",field_A_srf)
245
246      CALL wait_us(5000) ;
247    ENDDO
248
249!####################################################################################
250!!! Finalisation
251!####################################################################################
252
253!!! Fin des contextes
254
255    CALL xios_context_finalize()
256    CALL xios_get_handle("atmosphere",ctx_hdl)
257    CALL xios_set_current_context(ctx_hdl)
258    CALL xios_context_finalize()
259
260!!! Fin de XIOS
261
262    CALL xios_finalize()
263
264    CALL MPI_FINALIZE(ierr)
265
266  END PROGRAM test_complete
267
268
269
270
271
272
Note: See TracBrowser for help on using the repository browser.