source: XIOS/dev/branch_yushan/src/test/test_complete_omp.f90 @ 1115

Last change on this file since 1115 was 1115, checked in by yushan, 7 years ago

bug corrected in MPI_Gatherv

File size: 9.2 KB
Line 
1PROGRAM test_complete_omp
2
3  USE xios
4  USE mod_wait
5  use omp_lib
6  IMPLICIT NONE
7  INCLUDE "mpif.h"
8  INTEGER :: rank, size
9  INTEGER :: size_loc
10  INTEGER :: ierr
11
12  CHARACTER(len=*),PARAMETER :: id="client"
13  INTEGER :: comm, comm2
14  TYPE(xios_duration)  :: dtime
15  TYPE(xios_context) :: ctx_hdl
16  INTEGER,PARAMETER :: ni_glo=100
17  INTEGER,PARAMETER :: nj_glo=100
18  INTEGER,PARAMETER :: llm=5
19  DOUBLE PRECISION  :: lval(llm)=1
20  TYPE(xios_field) :: field_hdl
21  TYPE(xios_fieldgroup) :: fieldgroup_hdl
22  TYPE(xios_file) :: file_hdl
23  LOGICAL :: ok
24  CHARACTER(len=256) :: crname
25
26  DOUBLE PRECISION,DIMENSION(ni_glo,nj_glo) :: lon_glo,lat_glo
27  DOUBLE PRECISION :: field_A_glo(ni_glo,nj_glo,llm)
28  DOUBLE PRECISION,ALLOCATABLE :: lon(:,:),lat(:,:),field_A_atm(:,:,:), field_A_srf(:,:), lonvalue(:,:)
29  INTEGER, ALLOCATABLE :: kindex(:)
30  INTEGER :: ni,ibegin,iend,nj,jbegin,jend
31  INTEGER :: i,j,l,ts,n, nb_pt, provided
32
33!!! MPI Initialization
34
35  CALL MPI_INIT_THREAD(3, provided, ierr)
36    if(provided .NE. 3) then
37      print*, "provided thread level = ", provided
38      call MPI_Abort()
39    endif
40
41 
42
43  CALL init_wait
44
45  CALL MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr)
46  CALL MPI_COMM_SIZE(MPI_COMM_WORLD,size,ierr)
47  if(rank < size-1) then
48
49  !$omp parallel default(private)
50
51!!! XIOS Initialization (get the local communicator)
52
53  CALL xios_initialize(id,return_comm=comm)
54
55  CALL MPI_COMM_RANK(comm,rank,ierr)
56  CALL MPI_COMM_SIZE(comm,size_loc,ierr)
57
58  size_loc = size*omp_get_num_threads()
59  rank = rank*omp_get_num_threads() + omp_get_thread_num()
60
61
62!###########################################################################
63! Contexte ATM
64!###########################################################################
65
66!!! Initialisation des coordonnes globales et locales pour la grille rgulire
67
68  DO j=1,nj_glo
69    DO i=1,ni_glo
70      lon_glo(i,j)=(i-1)+(j-1)*ni_glo
71      lat_glo(i,j)=1000+(i-1)+(j-1)*ni_glo
72      DO l=1,llm
73        field_A_glo(i,j,l)=(i-1)+(j-1)*ni_glo+10000*l
74      ENDDO
75    ENDDO
76  ENDDO
77  ni=ni_glo ; ibegin=0
78
79  jbegin=0
80  DO n=0,size_loc-1
81    nj=nj_glo/size_loc
82    IF (n<MOD(nj_glo,size_loc)) nj=nj+1
83    IF (n==rank) exit
84    jbegin=jbegin+nj
85  ENDDO
86
87  iend=ibegin+ni-1 ; jend=jbegin+nj-1
88
89  ALLOCATE(lon(ni,nj),lat(ni,nj),field_A_atm(0:ni+1,-1:nj+2,llm),lonvalue(ni,nj))
90  lon(:,:)=lon_glo(ibegin+1:iend+1,jbegin+1:jend+1)
91  lat(:,:)=lat_glo(ibegin+1:iend+1,jbegin+1:jend+1)
92  field_A_atm(1:ni,1:nj,:)=field_A_glo(ibegin+1:iend+1,jbegin+1:jend+1,:)
93
94
95!!! Context ATMOSPHERE
96
97  CALL xios_context_initialize("atmosphere",comm)
98
99  CALL xios_get_handle("atmosphere",ctx_hdl)
100  CALL xios_set_current_context(ctx_hdl)
101
102  CALL xios_define_calendar(type="Gregorian", &
103                            start_date=xios_date(2000, 01, 01, 00, 00, 00), &
104                            time_origin=xios_date(1999, 01, 01, 15, 00, 00))
105
106  CALL xios_set_axis_attr("axis_atm",n_glo=llm ,value=lval) ;
107
108
109  CALL xios_set_domain_attr("domain_atm",ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, ni=ni,jbegin=jbegin,nj=nj, type='curvilinear')
110  CALL xios_set_domain_attr("domain_atm",data_dim=2, data_ibegin=-1, data_ni=ni+2, data_jbegin=-2, data_nj=nj+4)
111  CALL xios_set_domain_attr("domain_atm",lonvalue_2D=lon,latvalue_2D=lat)
112
113  CALL xios_set_domain_attr("domain_atm_zoom",ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, ni=ni,jbegin=jbegin,nj=nj)
114  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)
115  CALL xios_set_domain_attr("domain_atm_zoom",lonvalue_2D=lon,latvalue_2D=lat)
116
117
118!!! Activation du groupe field_definition
119
120  CALL xios_set_fieldgroup_attr("field_definition",enabled=.TRUE.)
121
122!!! Cration d un nouveau champ
123
124  CALL xios_get_handle("field_definition",fieldgroup_hdl)
125  CALL xios_add_child(fieldgroup_hdl,field_hdl,"field_B_atm")
126
127!!! Heritage des attributs d un autre champ
128
129  CALL xios_set_attr(field_hdl,field_ref="field_A_atm_zoom",name="field_B_atm")
130
131!!! Affectation de ce nouveau champ au fichier avec un nouveau nom
132
133  CALL xios_get_handle("output_atmosphere",file_hdl)
134  CALL xios_add_child(file_hdl,field_hdl)
135  CALL xios_set_attr(field_hdl,field_ref="field_B_atm",name="field_C_atm")
136
137!!! Definition du timestep
138
139  dtime%second=3600
140  CALL xios_set_timestep(timestep=dtime)
141
142!!! Recupration des valeurs des longitudes et de taille des domaines locaux (pour test de fonctionnalit)
143
144  ni=0 ; lonvalue(:,:)=0
145  CALL xios_get_domain_attr("domain_atm",ni=ni,lonvalue_2D=lonvalue)
146
147  !PRINT *,"ni",ni
148  !PRINT *,"lonvalue",lonvalue;
149
150!!! Fin de la definition du contexte
151
152  CALL xios_close_context_definition()
153
154   print *, "xios_close_context_definition(atmosphere)"
155
156!!! Test des valeurs des champs/fichiers
157
158  !!! Attribut defini ?
159
160  CALL xios_is_defined_field_attr("field_A_atm",enabled=ok)
161  PRINT *,"field_A_atm : attribute enabled is defined ? ",ok
162
163  !!! Recuperer la valeur d un attribut
164
165  CALL xios_get_field_attr("field_A_atm",name=crname)
166  PRINT *,"field_A_atm : attribute name is : ",TRIM(crname)
167
168  !!! Champ actif (besoin de fournir la valeur) ?
169
170    PRINT*,"field field_A_atm is active ? ",xios_field_is_active("field_A_atm")
171
172  !!! Champ defini ?
173
174    PRINT*,"field field_A_atm is valid ?",xios_is_valid_field("field_A_atm")
175
176
177!###########################################################################
178! Contexte SRF
179!###########################################################################
180
181!!! Initialisation des coordonnes globales et locales pour la grille indexee (1 point sur 2)
182
183!    nb_pt=ni*nj/2
184!    ALLOCATE(kindex(nb_pt),field_A_srf(nb_pt,llm))
185!    DO i=1,nb_pt
186!      kindex(i)=2*i-1
187!    ENDDO
188!    field_A_srf(1:nb_pt,:)=RESHAPE(field_A_glo(ibegin+1:iend+1:2,jbegin+1:jend+1,:),(/ nb_pt,llm /))
189
190!  CALL xios_context_initialize("surface",comm)
191
192!  CALL xios_get_handle("surface",ctx_hdl)
193!  CALL xios_set_current_context(ctx_hdl)
194
195!  CALL xios_define_calendar(type="Gregorian", &
196!                            start_date=xios_date(2000, 01, 01, 00, 00, 00), &
197!                            time_origin=xios_date(1999, 01, 01, 15, 00, 00))
198
199!  CALL xios_set_axis_attr("axis_srf",n_glo=llm ,value=lval)
200!  CALL xios_set_domain_attr("domain_srf",ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, ni=ni,jbegin=jbegin,nj=nj, type='curvilinear')
201!  CALL xios_set_domain_attr("domain_srf",data_dim=1, data_ibegin=0, data_ni=nb_pt)
202!  CALL xios_set_domain_attr("domain_srf",data_i_index=kindex)
203!  CALL xios_set_domain_attr("domain_srf",lonvalue_2D=lon,latvalue_2D=lat)
204
205!!! Cration d un nouveau champ
206
207 ! CALL xios_get_handle("field_definition",fieldgroup_hdl)
208!  CALL xios_add_child(fieldgroup_hdl,field_hdl,"field_B_srf")
209
210!!! Heritage des attributs d un autre champ
211
212!  CALL xios_set_attr(field_hdl,field_ref="field_A_srf",name="field_B_srf")
213
214!!! Affectation de ce nouveau champ au fichier avec un nouveau nom
215
216!  CALL xios_get_handle("output_surface",file_hdl)
217!  CALL xios_add_child(file_hdl,field_hdl)
218!  CALL xios_set_attr(field_hdl,field_ref="field_B_srf",name="field_C_srf")
219
220!!! Definition du timestep
221
222!  dtime%second=1800
223!  CALL xios_set_timestep(timestep=dtime)
224
225!!! Recupration des valeurs des longitudes et de taille des domaines locaux (pour test de fonctionnalit)
226
227!  ni=0 ; lonvalue(:,:)=0
228!  CALL xios_get_domain_attr("domain_srf",ni=ni,lonvalue_2D=lonvalue)
229
230  !PRINT *,"ni",ni
231  !PRINT *,"lonvalue",lonvalue ;
232
233!!! Fin de la definition du contexte SRF
234
235!  CALL xios_close_context_definition()
236
237!  print *, "xios_close_context_definition(surface)"
238
239
240!####################################################################################
241!!! Boucle temporelle
242!####################################################################################
243
244    !DO ts=1,24*10
245    DO ts=1,24
246
247      !CALL xios_get_handle("atmosphere",ctx_hdl)
248      !CALL xios_set_current_context(ctx_hdl)
249
250!!! Mise a jour du pas de temps
251
252      CALL xios_update_calendar(ts)
253
254!!! On donne la valeur du champ atm
255
256      CALL xios_send_field("field_A_atm",field_A_atm)
257
258!!! On change de contexte
259
260!      CALL xios_get_handle("surface",ctx_hdl)
261!      CALL xios_set_current_context(ctx_hdl)
262
263!!! Mise a jour du pas de temps
264
265 !     CALL xios_update_calendar(ts)
266
267!!! On donne la valeur du champ srf
268
269 !     CALL xios_send_field("field_A_srf",field_A_srf)
270
271      CALL wait_us(5000) ;
272
273
274    ENDDO
275
276     print *, "end temporal loop"
277
278!####################################################################################
279!!! Finalisation
280!####################################################################################
281
282!!! Fin des contextes
283
284
285!    CALL xios_get_handle("surface",ctx_hdl)
286
287!    CALL xios_set_current_context(ctx_hdl)
288
289!    CALL xios_context_finalize()
290
291!    print *, "xios_context_finalize(surface)"
292
293     !CALL xios_get_handle("atmosphere",ctx_hdl)
294
295     !CALL xios_set_current_context(ctx_hdl)
296
297     CALL xios_context_finalize()
298
299     print *, "xios_context_finalize(atmosphere)"
300
301   
302
303!!! Fin de XIOS
304
305   
306
307    CALL xios_finalize()
308
309    DEALLOCATE(lon, lat, field_A_atm, lonvalue)
310!    DEALLOCATE(kindex, field_A_srf)
311
312     print *, "Client : xios_finalize "
313
314    !$omp master
315    CALL MPI_COMM_FREE(comm, ierr)
316    !$omp end master
317
318    !$omp barrier
319
320    print*, "MPI_COMM_FREE OK", rank, size_loc
321
322  !$omp end parallel
323
324  else
325
326    CALL xios_init_server
327    print *, "Server : xios_finalize "
328 
329    endif
330
331
332    CALL MPI_FINALIZE(ierr)
333
334  END PROGRAM test_complete_omp
335
336
337
338
339
340
Note: See TracBrowser for help on using the repository browser.