source: XIOS/trunk/src/test/test_unstruct_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: 6.2 KB
Line 
1PROGRAM test_unstruct_complete
2
3  USE xios
4  USE mod_wait
5  IMPLICIT NONE
6  INCLUDE "mpif.h"
7  INTEGER :: mpi_rank
8  INTEGER :: mpi_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 :: nlon=60
16  INTEGER, PARAMETER :: nlat=30
17  INTEGER,PARAMETER :: ni_glo=100
18  INTEGER,PARAMETER :: nj_glo=100
19  INTEGER,PARAMETER :: llm=5
20  DOUBLE PRECISION  :: lval(llm)=1
21  TYPE(xios_field) :: field_hdl
22  TYPE(xios_fieldgroup) :: fieldgroup_hdl
23  TYPE(xios_file) :: file_hdl
24  LOGICAL :: ok
25
26  DOUBLE PRECISION,ALLOCATABLE :: lon_glo(:),lat_glo(:)
27  DOUBLE PRECISION,ALLOCATABLE :: bounds_lon_glo(:,:),bounds_lat_glo(:,:)
28  DOUBLE PRECISION,ALLOCATABLE :: field_A_glo(:,:)
29  INTEGER,ALLOCATABLE :: i_index_glo(:)
30  INTEGER,ALLOCATABLE :: i_index(:)
31  LOGICAL,ALLOCATABLE :: mask_glo(:),mask(:)
32  DOUBLE PRECISION,ALLOCATABLE :: lon(:),lat(:),field_A_srf(:,:), lonvalue(:) ;
33  DOUBLE PRECISION,ALLOCATABLE :: bounds_lon(:,:),bounds_lat(:,:) ;
34  INTEGER :: ni,ibegin,iend,nj,jbegin,jend
35  INTEGER :: i,j,l,ts,n
36  INTEGER :: ncell_glo,ncell,ind
37  REAL :: ilon,ilat
38  DOUBLE PRECISION, PARAMETER :: Pi=3.14159265359
39  INTEGER :: list_ind(nlon,nlat)
40  INTEGER :: rank,j1,j2,np,ncell_x
41  INTEGER :: data_n_index
42  INTEGER,ALLOCATABLE :: data_i_index(:)
43  DOUBLE PRECISION,ALLOCATABLE :: field_A_compressed(:,:)
44
45  CALL xios_initialize(id,return_comm=comm)
46  CALL MPI_COMM_RANK(comm,mpi_rank,ierr)
47  CALL MPI_COMM_SIZE(comm,mpi_size,ierr)
48
49  CALL init_wait
50
51  ncell_glo=0
52  DO j=1,nlat
53    n =  NINT(COS(Pi/2-(j-0.5)*PI/nlat)*nlon)
54    IF (n<8) n=8
55    ncell_glo=ncell_glo+n
56  ENDDO
57
58  ALLOCATE(lon_glo(ncell_glo))
59  ALLOCATE(lat_glo(ncell_glo))
60  ALLOCATE(bounds_lon_glo(4,ncell_glo))
61  ALLOCATE(bounds_lat_glo(4,ncell_glo))
62  ALLOCATE(i_index_glo(ncell_glo))
63  ALLOCATE(field_A_glo(ncell_glo,llm))
64  ALLOCATE(mask_glo(ncell_glo))
65
66  ind=0
67  DO j=1,nlat
68    n = NINT(COS(Pi/2-(j-0.5)*PI/nlat)*nlon)
69    if (j==1) PRINT*,"--- ",n
70    if (j==nlat) PRINT*,"--- ",n
71    IF (n<8) n=8
72
73    DO i=1,n
74      ind=ind+1
75      list_ind(i,j)=ind
76      ilon=i-0.5
77      ilat=j-0.5
78
79      lat_glo(ind)= 90-(ilat*180./nlat)
80      lon_glo(ind)= (ilon*360./n)
81
82
83      bounds_lat_glo(1,ind)= 90-((ilat-0.5)*180./nlat)
84      bounds_lon_glo(1,ind)=((ilon-0.5)*360./n)
85
86      bounds_lat_glo(2,ind)= 90-((ilat-0.5)*180./nlat)
87      bounds_lon_glo(2,ind)=((ilon+0.5)*360./n)
88
89      bounds_lat_glo(3,ind)= 90-((ilat+0.5)*180./nlat)
90      bounds_lon_glo(3,ind)=((ilon+0.5)*360./n)
91
92      bounds_lat_glo(4,ind)= 90-((ilat+0.5)*180./nlat)
93      bounds_lon_glo(4,ind)=((ilon-0.5)*360./n)
94
95    ENDDO
96  ENDDO
97
98!  mpi_size=32
99  rank=(mpi_size-1)/2
100  ncell_x=sqrt(ncell_glo*1./mpi_size)
101
102  j1=nlat/2
103  DO WHILE(rank>=0)
104    j2=MAX(j1-ncell_x+1,1)
105    j=(j1+j2)/2
106    n=NINT(COS(Pi/2-(j-0.5)*PI/nlat)*nlon)
107    np = MIN(n/ncell_x,rank+1) ;
108    if (j2==1) np=rank+1
109
110    PRINT *,"domain ",j2,j1,rank,np ;
111    DO j=j2,j1
112      n=NINT(COS(Pi/2-(j-0.5)*PI/nlat)*nlon)
113      IF (n<8) n=8
114      DO i=1,n
115        ind=list_ind(i,j)
116        IF ( (i-1) < MOD(n,np)*(n/np+1)) THEN
117          i_index_glo(ind) = rank - (i-1)/(n/np+1)
118        ELSE
119          i_index_glo(ind) = rank-(MOD(n,np)+ (i-1-MOD(n,np)*(n/np+1))/(n/np))
120        ENDIF
121      ENDDO
122    ENDDO
123    rank=rank-np
124    j1=j2-1
125  ENDDO
126
127  rank=(mpi_size-1)/2+1
128  ncell_x=sqrt(ncell_glo*1./mpi_size)
129
130  j1=nlat/2+1
131  DO WHILE(rank<=mpi_size-1)
132    j2=MIN(j1+ncell_x-1,nlat)
133    j=(j1+j2)/2
134    n=NINT(COS(Pi/2-(j-0.5)*PI/nlat)*nlon)
135    np = MIN(n/ncell_x,mpi_size-rank) ;
136    if (j2==nlat) np=mpi_size-rank
137
138    PRINT *,"domain ",j2,j1,rank,np ;
139    DO j=j1,j2
140      n=NINT(COS(Pi/2-(j-0.5)*PI/nlat)*nlon)
141      IF (n<8) n=8
142      DO i=1,n
143        ind=list_ind(i,j)
144        IF ( (i-1) < MOD(n,np)*(n/np+1)) THEN
145          i_index_glo(ind) = rank + (i-1)/(n/np+1)
146        ELSE
147          i_index_glo(ind) = rank+(MOD(n,np)+ (i-1-MOD(n,np)*(n/np+1))/(n/np))
148        ENDIF
149      ENDDO
150    ENDDO
151    rank=rank+np
152    j1=j2+1
153  ENDDO
154
155  ncell=0
156  DO ind=1,ncell_glo
157    IF (i_index_glo(ind)==mpi_rank) ncell=ncell+1
158  ENDDO
159  ALLOCATE(i_index(ncell))
160  ALLOCATE(lon(ncell))
161  ALLOCATE(lat(ncell))
162  ALLOCATE(bounds_lon(4,ncell))
163  ALLOCATE(bounds_lat(4,ncell))
164  ALLOCATE(field_A_srf(ncell,llm))
165  ALLOCATE(mask(ncell))
166  ncell=0
167  data_n_index=0
168  DO ind=1,ncell_glo
169    IF (i_index_glo(ind)==mpi_rank) THEN
170      ncell=ncell+1
171      i_index(ncell)=ind-1
172      lon(ncell)=lon_glo(ind)
173      lat(ncell)=lat_glo(ind)
174      bounds_lon(:,ncell)=bounds_lon_glo(:,ind)
175      bounds_lat(:,ncell)=bounds_lat_glo(:,ind)
176      field_A_srf(ncell,:)=i_index_glo(ind)
177      IF (MOD(ind,8)>=0 .AND. MOD(ind,8)<2) THEN
178        mask(ncell)=.FALSE.
179      ELSE
180        mask(ncell)=.TRUE.
181        data_n_index=data_n_index+1
182      ENDIF
183    ENDIF
184  ENDDO
185
186  ALLOCATE(field_A_compressed(data_n_index,llm))
187  ALLOCATE(data_i_index(data_n_index))
188  data_n_index=0
189  DO ind=1,ncell
190    IF (mask(ind)) THEN
191      data_n_index=data_n_index+1
192      data_i_index(data_n_index)=ind
193      field_A_compressed(data_n_index,:)=field_A_srf(ind,:)
194    ENDIF
195  ENDDO
196
197  CALL xios_context_initialize("surface",comm)
198  CALL xios_get_handle("surface",ctx_hdl)
199  CALL xios_set_current_context(ctx_hdl)
200
201  CALL xios_define_calendar(type="Julian", &
202                            start_date=xios_date(2012, 03, 01, 15, 00, 00), &
203                            time_origin=xios_date(2012, 02, 29, 15, 00, 00))
204
205  CALL xios_set_axis_attr("axis_srf",size=llm ,value=lval) ;
206  CALL xios_set_domain_attr("domain_srf",ni_glo=ncell_glo, ni=ncell, ibegin=1, i_index=RESHAPE(i_index,(/ncell,1/) ))
207  CALL xios_set_domain_attr("domain_srf",data_dim=1, data_ni=data_n_index, data_n_index=data_n_index, data_i_index=data_i_index, type='unstructured')
208  CALL xios_set_domain_attr("domain_srf",lonvalue=lon,latvalue=lat)
209  CALL xios_set_domain_attr("domain_srf", nvertex=4, bounds_lon=bounds_lon, bounds_lat=bounds_lat )
210
211
212  dtime%second=3600
213  CALL xios_set_context_attr("surface", timestep=dtime)
214  CALL xios_close_context_definition()
215
216   DO ts=1,24*10
217     CALL xios_update_calendar(ts)
218     CALL xios_send_field("field_A_srf",field_A_compressed)
219    ENDDO
220
221    CALL xios_context_finalize()
222    CALL xios_finalize()
223
224  END PROGRAM test_unstruct_complete
225
226
227
228
229
Note: See TracBrowser for help on using the repository browser.