source: codes/icosagcm/trunk/src/xios_mod.F90 @ 482

Last change on this file since 482 was 482, checked in by ymipsl, 8 years ago

Dynamico can run without XIOS

YM

File size: 18.2 KB
Line 
1MODULE xios_mod
2
3#ifdef CPP_USING_XIOS
4   USE xios
5#endif
6
7  PUBLIC
8  LOGICAL,SAVE :: using_xios
9
10  INTEGER,SAVE :: ncell_i
11!$OMP THREADPRIVATE(ncell_i)
12  INTEGER,SAVE :: ncell_v
13!$OMP THREADPRIVATE(ncell_v)
14
15  PRIVATE ncell_i,ncell_v
16
17#ifdef CPP_USING_XIOS
18 
19CONTAINS
20 
21 SUBROUTINE xios_init
22   USE getin_mod
23   USE xios
24   USE mpipara
25   IMPLICIT NONE
26    TYPE(xios_context) :: ctx_hdl
27
28     using_xios=.TRUE.
29     CALL xios_context_initialize("icosagcm",comm_icosa)
30     CALL xios_get_handle("icosagcm",ctx_hdl)
31     CALL xios_set_current_context(ctx_hdl)
32   
33 END SUBROUTINE xios_init 
34 
35 SUBROUTINE xios_init_write_field
36 USE genmod
37 USE mpipara
38 USE xios
39 USE grid_param
40 USE domain_mod
41 USE dimensions
42 USE spherical_geom_mod
43 USE geometry
44 USE mpi_mod
45 USE time_mod
46 USE metric, ONLY : vup,vdown
47 IMPLICIT NONE
48  TYPE(xios_context) :: ctx_hdl
49  TYPE(xios_duration)      :: dtime
50  REAL(rstd) :: lev_value(llm)
51  REAL(rstd) :: lev_valuep1(llm+1)
52  INTEGER :: ncell, ncell_tot, ncell_glo(0:mpi_size-1), displ
53  INTEGER :: ind, i,j,k,l
54  REAL(rstd),ALLOCATABLE    :: lon(:), lat(:), bounds_lon(:,:), bounds_lat(:,:)
55  TYPE(t_domain),POINTER :: d
56
57!$OMP BARRIER
58!$OMP MASTER
59!   CALL xios_context_initialize("icosagcm",comm_icosa)
60   CALL xios_get_handle("icosagcm",ctx_hdl)
61   CALL xios_set_current_context(ctx_hdl)
62   lev_value(:) = (/ (l,l=1,llm) /)     
63   lev_valuep1(:) = (/ (l,l=1,llm+1) /)     
64   CALL xios_set_axis_attr("lev",n_glo=llm ,value=lev_value) ;
65   CALL xios_set_axis_attr("levp1",n_glo=llm+1 ,value=lev_valuep1) ;
66   
67   ncell=0
68   DO ind=1,ndomain
69     d=>domain(ind)
70       
71     DO j=d%jj_begin,d%jj_end
72       DO i=d%ii_begin,d%ii_end
73         IF (domain(ind)%own(i,j)) ncell=ncell+1
74       ENDDO
75     ENDDO
76   ENDDO     
77   ncell_i=ncell
78   
79   CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
80
81   displ=0
82   DO i=1,mpi_rank
83     displ=displ+ncell_glo(i-1)
84   ENDDO
85
86   ncell_tot=sum(ncell_glo(:))
87   
88   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:5,ncell), bounds_lat(0:5,ncell)) 
89   
90   ncell=0
91   DO ind=1,ndomain
92     d=>domain(ind)
93       
94     DO j=d%jj_begin,d%jj_end
95       DO i=d%ii_begin,d%ii_end
96         IF (domain(ind)%own(i,j)) THEN
97           ncell=ncell+1
98           CALL xyz2lonlat(d%xyz(:,i,j),lon(ncell),lat(ncell))
99           lon(ncell)=lon(ncell)*180/Pi
100           lat(ncell)=lat(ncell)*180/Pi
101           DO k=0,5
102             CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ncell), bounds_lat(k,ncell))
103             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
104             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
105           ENDDO
106         ENDIF
107       ENDDO
108     ENDDO
109   ENDDO         
110
111 
112   CALL xios_set_domaingroup_attr("i",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
113   CALL xios_set_domaingroup_attr("i", data_dim=1, type='unstructured' , nvertex=6)
114   CALL xios_set_domaingroup_attr("i",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
115   
116   DEALLOCATE(lon, lat, bounds_lon, bounds_lat) 
117   
118   ncell=0
119   DO ind=1,ndomain
120     d=>domain(ind)
121       
122     DO j=d%jj_begin+1,d%jj_end
123       DO i=d%ii_begin,d%ii_end-1
124         ncell=ncell+1
125       ENDDO
126     ENDDO
127
128     DO j=d%jj_begin,d%jj_end-1
129       DO i=d%ii_begin+1,d%ii_end
130          ncell=ncell+1
131        ENDDO
132     ENDDO
133
134   ENDDO     
135   
136   ncell_v=ncell
137   
138   CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr)
139
140   displ=0
141   DO i=1,mpi_rank
142     displ=displ+ncell_glo(i-1)
143   ENDDO
144
145   ncell_tot=sum(ncell_glo(:))
146   
147   ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:2,ncell), bounds_lat(0:2,ncell)) 
148   
149   ncell=0
150   DO ind=1,ndomain
151     d=>domain(ind)
152 
153     DO j=d%jj_begin+1,d%jj_end
154       DO i=d%ii_begin,d%ii_end-1
155           ncell=ncell+1
156           CALL xyz2lonlat(d%vertex(:,vdown,i,j),lon(ncell),lat(ncell))
157           lon(ncell)=lon(ncell)*180/Pi
158           lat(ncell)=lat(ncell)*180/Pi
159
160           CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,ncell), bounds_lat(0,ncell))
161           CALL xyz2lonlat(d%xyz(:,i,j-1),bounds_lon(1,ncell), bounds_lat(1,ncell))
162           CALL xyz2lonlat(d%xyz(:,i+1,j-1),bounds_lon(2,ncell), bounds_lat(2,ncell))
163
164           DO k=0,2
165             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
166             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
167           ENDDO
168         ENDDO
169       ENDDO 
170 
171       DO j=d%jj_begin,d%jj_end-1
172         DO i=d%ii_begin+1,d%ii_end
173           ncell=ncell+1
174           CALL xyz2lonlat(d%vertex(:,vup,i,j),lon(ncell),lat(ncell))
175           lon(ncell)=lon(ncell)*180/Pi
176           lat(ncell)=lat(ncell)*180/Pi
177           CALL xyz2lonlat(d%xyz(:,i,j),bounds_lon(0,ncell), bounds_lat(0,ncell))
178           CALL xyz2lonlat(d%xyz(:,i,j+1),bounds_lon(1,ncell), bounds_lat(1,ncell))
179           CALL xyz2lonlat(d%xyz(:,i-1,j+1),bounds_lon(2,ncell), bounds_lat(2,ncell))
180
181           DO k=0,2
182             bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi
183             bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi
184           ENDDO
185         ENDDO
186       ENDDO 
187       
188   ENDDO         
189
190 
191   CALL xios_set_domain_attr("v",ni_glo=ncell_tot, ibegin=displ, ni=ncell)
192   CALL xios_set_domain_attr("v", data_dim=1, type='unstructured' , nvertex=3)
193   CALL xios_set_domain_attr("v",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat)
194
195
196   dtime%second=dt
197   CALL xios_set_timestep(dtime)
198   
199   CALL xios_set_fieldgroup_attr("standard_output", freq_op=itau_out*xios_timestep, freq_offset=(itau_out-1)*xios_timestep)
200   
201   CALL xios_close_context_definition()
202!$OMP END MASTER
203!$OMP BARRIER
204   
205 END SUBROUTINE xios_init_write_field
206 
207 
208 SUBROUTINE xios_write_field(name,field)
209 USE field_mod
210 IMPLICIT NONE
211   CHARACTER(LEN=*),INTENT(IN) :: name
212   TYPE(t_field), POINTER :: field(:)
213   CHARACTER(LEN=10) :: str_number
214   INTEGER :: iq
215
216!$OMP BARRIER
217!$OMP MASTER
218   
219   IF (Field(1)%field_type==field_T) THEN
220     IF (field(1)%ndim==2) THEN
221        CALL xios_write_field_scalar(name,field,1)
222      ELSE IF (field(1)%ndim==3) THEN
223        CALL xios_write_field_scalar(name,field,size(field(1)%rval3d,2))
224      ELSE IF (field(1)%ndim==4) THEN
225        DO iq=1,size(field(1)%rval4d,3)
226          WRITE(str_number,'(i10)') iq
227          CALL xios_write_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
228        ENDDO
229      ELSE
230        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
231      ENDIF
232    ELSE IF (Field(1)%field_type==field_Z) THEN
233     IF (field(1)%ndim==2) THEN
234        CALL xios_write_field_vort(name,field,1)
235      ELSE IF (field(1)%ndim==3) THEN
236        CALL xios_write_field_vort(name,field,size(field(1)%rval3d,2))
237      ELSE IF (field(1)%ndim==4) THEN
238        DO iq=1,size(field(1)%rval4d,3)
239          WRITE(str_number,'(i10)') iq
240          CALL xios_write_field_vort(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
241        ENDDO
242      ELSE
243        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
244      ENDIF
245    ENDIF
246!$OMP END MASTER
247!$OMP BARRIER
248     
249 END SUBROUTINE xios_write_field
250
251 SUBROUTINE xios_read_field(name,field)
252 USE field_mod
253 IMPLICIT NONE
254   CHARACTER(LEN=*),INTENT(IN) :: name
255   TYPE(t_field), POINTER :: field(:)
256   CHARACTER(LEN=10) :: str_number
257   INTEGER :: iq
258
259!$OMP BARRIER
260!$OMP MASTER
261   
262   IF (Field(1)%field_type==field_T) THEN
263     IF (field(1)%ndim==2) THEN
264        CALL xios_read_field_scalar(name,field,1)
265      ELSE IF (field(1)%ndim==3) THEN
266        CALL xios_read_field_scalar(name,field,size(field(1)%rval3d,2))
267      ELSE IF (field(1)%ndim==4) THEN
268        DO iq=1,size(field(1)%rval4d,3)
269          WRITE(str_number,'(i10)') iq
270          CALL xios_read_field_scalar(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
271        ENDDO
272      ELSE
273        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
274      ENDIF
275    ELSE IF (Field(1)%field_type==field_Z) THEN
276     IF (field(1)%ndim==2) THEN
277        CALL xios_read_field_vort(name,field,1)
278      ELSE IF (field(1)%ndim==3) THEN
279        CALL xios_read_field_vort(name,field,size(field(1)%rval3d,2))
280      ELSE IF (field(1)%ndim==4) THEN
281        DO iq=1,size(field(1)%rval4d,3)
282          WRITE(str_number,'(i10)') iq
283          CALL xios_read_field_vort(name//TRIM(ADJUSTL(str_number)),field,size(field(1)%rval4d,2),iq)
284        ENDDO
285      ELSE
286        PRINT *, "xios_write_field : dimension > 4 are not supported for now"
287      ENDIF
288    ENDIF
289!$OMP END MASTER
290!$OMP BARRIER
291     
292 END SUBROUTINE xios_read_field
293
294
295 
296 SUBROUTINE xios_write_field_scalar(name,field,nlev,iq)
297 USE genmod
298 USE mpipara
299 USE xios
300 USE grid_param
301 USE domain_mod
302 USE dimensions
303 USE spherical_geom_mod
304 USE geometry
305 USE mpi_mod
306 IMPLICIT NONE
307   CHARACTER(LEN=*),INTENT(IN) :: name
308   TYPE(t_field), POINTER :: field(:)
309   INTEGER,INTENT(IN) :: nlev
310   INTEGER,INTENT(IN),OPTIONAL :: iq
311   
312   REAL(rstd) :: field_tmp(ncell_i,nlev)
313   TYPE(t_domain),POINTER :: d
314   INTEGER :: n,i,j,ij,ind
315   
316   IF (field(1)%ndim==2) THEN
317     n=0
318     DO ind=1,ndomain
319       
320       d=>domain(ind)
321       
322       DO j=d%jj_begin,d%jj_end
323         DO i=d%ii_begin,d%ii_end
324           IF (d%own(i,j)) THEN
325             n=n+1
326             ij=d%iim*(j-1)+i
327             field_tmp(n,1)=field(ind)%rval2d(ij)
328           ENDIF
329         ENDDO
330       ENDDO
331     ENDDO
332   ELSE IF (field(1)%ndim==3) THEN
333     n=0
334     DO ind=1,ndomain
335       d=>domain(ind)
336       
337       DO j=d%jj_begin,d%jj_end
338         DO i=d%ii_begin,d%ii_end
339           IF (d%own(i,j)) THEN
340             n=n+1
341             ij=d%iim*(j-1)+i
342             field_tmp(n,:)=field(ind)%rval3d(ij,:)
343           ENDIF
344         ENDDO
345       ENDDO
346     ENDDO
347   ELSE IF (field(1)%ndim==4) THEN
348     n=0
349     DO ind=1,ndomain
350       d=>domain(ind)
351       
352       DO j=d%jj_begin,d%jj_end
353         DO i=d%ii_begin,d%ii_end
354           IF (d%own(i,j)) THEN
355             n=n+1
356             ij=d%iim*(j-1)+i
357             field_tmp(n,:)=field(ind)%rval4d(ij,:,iq)
358           ENDIF
359         ENDDO
360       ENDDO
361     ENDDO     
362   ENDIF
363   
364   CALL xios_send_field(name,field_tmp)
365 
366 END SUBROUTINE xios_write_field_scalar 
367
368
369 SUBROUTINE xios_read_field_scalar(name,field,nlev,iq)
370 USE genmod
371 USE mpipara
372 USE xios
373 USE grid_param
374 USE domain_mod
375 USE dimensions
376 USE spherical_geom_mod
377 USE geometry
378 USE mpi_mod
379 IMPLICIT NONE
380   CHARACTER(LEN=*),INTENT(IN) :: name
381   TYPE(t_field), POINTER :: field(:)
382   INTEGER,INTENT(IN) :: nlev
383   INTEGER,INTENT(IN),OPTIONAL :: iq
384   
385   REAL(rstd) :: field_tmp(ncell_i,nlev)
386   TYPE(t_domain),POINTER :: d
387   INTEGER :: n,i,j,ij,ind
388
389   CALL xios_recv_field(name,field_tmp)
390   
391   IF (field(1)%ndim==2) THEN
392     n=0
393     DO ind=1,ndomain
394       
395       d=>domain(ind)
396       
397       DO j=d%jj_begin,d%jj_end
398         DO i=d%ii_begin,d%ii_end
399           IF (d%own(i,j)) THEN
400             n=n+1
401             ij=d%iim*(j-1)+i
402             field(ind)%rval2d(ij)=field_tmp(n,1)
403           ENDIF
404         ENDDO
405       ENDDO
406     ENDDO
407   ELSE IF (field(1)%ndim==3) THEN
408     n=0
409     DO ind=1,ndomain
410       d=>domain(ind)
411       
412       DO j=d%jj_begin,d%jj_end
413         DO i=d%ii_begin,d%ii_end
414           IF (d%own(i,j)) THEN
415             n=n+1
416             ij=d%iim*(j-1)+i
417             field(ind)%rval3d(ij,:)=field_tmp(n,:)
418           ENDIF
419         ENDDO
420       ENDDO
421     ENDDO
422   ELSE IF (field(1)%ndim==4) THEN
423     n=0
424     DO ind=1,ndomain
425       d=>domain(ind)
426       
427       DO j=d%jj_begin,d%jj_end
428         DO i=d%ii_begin,d%ii_end
429           IF (d%own(i,j)) THEN
430             n=n+1
431             ij=d%iim*(j-1)+i
432             field(ind)%rval4d(ij,:,iq)=field_tmp(n,:)
433           ENDIF
434         ENDDO
435       ENDDO
436     ENDDO     
437   ENDIF
438 
439 END SUBROUTINE xios_read_field_scalar
440
441
442     
443 SUBROUTINE xios_write_field_vort(name,field,nlev,iq)
444 USE genmod
445 USE mpipara
446 USE xios
447 USE grid_param
448 USE domain_mod
449 USE dimensions
450 USE spherical_geom_mod
451 USE geometry
452 USE mpi_mod
453 IMPLICIT NONE
454   CHARACTER(LEN=*),INTENT(IN) :: name
455   TYPE(t_field), POINTER :: field(:)
456   INTEGER,INTENT(IN) :: nlev
457   INTEGER,INTENT(IN),OPTIONAL :: iq
458   
459   REAL(rstd) :: field_tmp(ncell_v,nlev)
460   TYPE(t_domain),POINTER :: d
461   INTEGER :: n,i,j,ij,ind
462   
463   IF (field(1)%ndim==2) THEN
464     n=0
465     DO ind=1,ndomain
466       d=>domain(ind)
467       CALL swap_dimensions(ind) 
468       
469       DO j=d%jj_begin+1,d%jj_end
470         DO i=d%ii_begin,d%ii_end-1
471           n=n+1
472           ij=iim*(j-1)+i
473           Field_tmp(n,1)=field(ind)%rval2d(ij+z_down)
474         ENDDO
475       ENDDO
476
477       DO j=d%jj_begin,d%jj_end-1
478         DO i=d%ii_begin+1,d%ii_end
479           n=n+1
480           ij=iim*(j-1)+i
481           Field_tmp(n,1)=field(ind)%rval2d(ij+z_up)
482          ENDDO
483       ENDDO
484         
485     ENDDO
486
487   ELSE IF (field(1)%ndim==3) THEN
488     n=0
489     DO ind=1,ndomain
490       d=>domain(ind)
491       CALL swap_dimensions(ind)   
492             
493       DO j=d%jj_begin+1,d%jj_end
494         DO i=d%ii_begin,d%ii_end-1
495           n=n+1
496           ij=iim*(j-1)+i
497           Field_tmp(n,:)=field(ind)%rval3d(ij+z_down,:)
498         ENDDO
499       ENDDO
500
501       DO j=d%jj_begin,d%jj_end-1
502         DO i=d%ii_begin+1,d%ii_end
503           n=n+1
504           ij=iim*(j-1)+i
505           Field_tmp(n,:)=field(ind)%rval3d(ij+z_up,:)
506          ENDDO
507       ENDDO
508         
509     ENDDO
510
511   ELSE IF (field(1)%ndim==4) THEN
512     n=0
513     DO ind=1,ndomain
514       d=>domain(ind)
515       CALL swap_dimensions(ind) 
516               
517       DO j=d%jj_begin+1,d%jj_end
518         DO i=d%ii_begin,d%ii_end-1
519           n=n+1
520           ij=iim*(j-1)+i
521           Field_tmp(n,:)=field(ind)%rval4d(ij+z_down,:,iq)
522         ENDDO
523       ENDDO
524
525       DO j=d%jj_begin,d%jj_end-1
526         DO i=d%ii_begin+1,d%ii_end
527           n=n+1
528           ij=iim*(j-1)+i
529           Field_tmp(n,:)=field(ind)%rval4d(ij+z_up,:,iq)
530          ENDDO
531       ENDDO
532         
533     ENDDO
534
535   ENDIF
536   
537   CALL xios_send_field(name,field_tmp)
538 
539 END SUBROUTINE xios_write_field_vort 
540
541 SUBROUTINE xios_read_field_vort(name,field,nlev,iq)
542 USE genmod
543 USE mpipara
544 USE xios
545 USE grid_param
546 USE domain_mod
547 USE dimensions
548 USE spherical_geom_mod
549 USE geometry
550 USE mpi_mod
551 IMPLICIT NONE
552   CHARACTER(LEN=*),INTENT(IN) :: name
553   TYPE(t_field), POINTER :: field(:)
554   INTEGER,INTENT(IN) :: nlev
555   INTEGER,INTENT(IN),OPTIONAL :: iq
556   
557   REAL(rstd) :: field_tmp(ncell_v,nlev)
558   TYPE(t_domain),POINTER :: d
559   INTEGER :: n,i,j,ij,ind
560
561   CALL xios_recv_field(name,field_tmp)
562
563   
564   IF (field(1)%ndim==2) THEN
565     n=0
566     DO ind=1,ndomain
567       d=>domain(ind)
568       CALL swap_dimensions(ind) 
569       
570       DO j=d%jj_begin+1,d%jj_end
571         DO i=d%ii_begin,d%ii_end-1
572           n=n+1
573           ij=iim*(j-1)+i
574           field(ind)%rval2d(ij+z_down)=Field_tmp(n,1)
575         ENDDO
576       ENDDO
577
578       DO j=d%jj_begin,d%jj_end-1
579         DO i=d%ii_begin+1,d%ii_end
580           n=n+1
581           ij=iim*(j-1)+i
582           Field_tmp(n,1)=field(ind)%rval2d(ij+z_up)
583           field(ind)%rval2d(ij+z_up)=Field_tmp(n,1)
584          ENDDO
585       ENDDO
586         
587     ENDDO
588
589   ELSE IF (field(1)%ndim==3) THEN
590     n=0
591     DO ind=1,ndomain
592       d=>domain(ind)
593       CALL swap_dimensions(ind)   
594             
595       DO j=d%jj_begin+1,d%jj_end
596         DO i=d%ii_begin,d%ii_end-1
597           n=n+1
598           ij=iim*(j-1)+i
599           field(ind)%rval3d(ij+z_down,:)=Field_tmp(n,:)
600         ENDDO
601       ENDDO
602
603       DO j=d%jj_begin,d%jj_end-1
604         DO i=d%ii_begin+1,d%ii_end
605           n=n+1
606           ij=iim*(j-1)+i
607           field(ind)%rval3d(ij+z_up,:)=Field_tmp(n,:)
608          ENDDO
609       ENDDO
610         
611     ENDDO
612
613   ELSE IF (field(1)%ndim==4) THEN
614     n=0
615     DO ind=1,ndomain
616       d=>domain(ind)
617       CALL swap_dimensions(ind) 
618               
619       DO j=d%jj_begin+1,d%jj_end
620         DO i=d%ii_begin,d%ii_end-1
621           n=n+1
622           ij=iim*(j-1)+i
623           field(ind)%rval4d(ij+z_down,:,iq)=Field_tmp(n,:)
624         ENDDO
625       ENDDO
626
627       DO j=d%jj_begin,d%jj_end-1
628         DO i=d%ii_begin+1,d%ii_end
629           n=n+1
630           ij=iim*(j-1)+i
631           field(ind)%rval4d(ij+z_up,:,iq)=Field_tmp(n,:)
632          ENDDO
633       ENDDO
634         
635     ENDDO
636
637   ENDIF
638 
639 END SUBROUTINE xios_read_field_vort 
640
641
642
643
644 
645 SUBROUTINE xios_write_field_finalize
646 IMPLICIT NONE
647
648!$OMP BARRIER
649!$OMP MASTER
650   CALL xios_context_finalize
651!$OMP END MASTER
652!$OMP BARRIER
653
654 END SUBROUTINE xios_write_field_finalize
655
656 SUBROUTINE xios_set_context
657 IMPLICIT NONE   
658  TYPE(xios_context) :: ctx_hdl
659
660!$OMP MASTER
661   CALL xios_get_handle("icosagcm",ctx_hdl)
662   CALL xios_set_current_context(ctx_hdl)
663!$OMP END MASTER
664
665  END SUBROUTINE xios_set_context
666
667
668#else
669 
670
671INTERFACE xios_send_field
672  MODULE PROCEDURE xios_send_field_scalar, xios_send_field_1d
673END INTERFACE  xios_send_field
674
675
676CONTAINS 
677 
678 
679  SUBROUTINE xios_init
680   IMPLICIT NONE
681         
682    using_xios=.FALSE.
683   
684  END SUBROUTINE xios_init
685 
686  SUBROUTINE xios_send_field_scalar(name,field)
687  IMPLICIT NONE
688    CHARACTER(LEN=*),INTENT(IN) :: name
689    REAL,INTENT(IN) :: field
690  END SUBROUTINE xios_send_field_scalar 
691
692  SUBROUTINE xios_send_field_1d(name,field)
693  IMPLICIT NONE
694    CHARACTER(LEN=*),INTENT(IN) :: name
695    REAL,INTENT(IN) :: field(:)
696  END SUBROUTINE xios_send_field_1d 
697 
698  SUBROUTINE xios_write_field(name,field)
699  USE field_mod
700  IMPLICIT NONE
701   CHARACTER(LEN=*),INTENT(IN) :: name
702   TYPE(t_field), POINTER :: field(:)
703  END SUBROUTINE xios_write_field
704
705  SUBROUTINE xios_read_field(name,field)
706  USE field_mod
707  IMPLICIT NONE
708   CHARACTER(LEN=*),INTENT(IN) :: name
709   TYPE(t_field), POINTER :: field(:)
710  END SUBROUTINE xios_read_field
711 
712  SUBROUTINE xios_update_calendar(step)
713  IMPLICIT NONE
714   INTEGER, INTENT(IN):: step 
715  END SUBROUTINE xios_update_calendar
716
717  SUBROUTINE xios_write_field_finalize
718  END SUBROUTINE xios_write_field_finalize
719 
720  SUBROUTINE xios_init_write_field
721  END SUBROUTINE xios_init_write_field 
722 
723  SUBROUTINE xios_set_context
724  END SUBROUTINE xios_set_context
725 
726  SUBROUTINE xios_set_fieldgroup_attr(name,enabled)
727    CHARACTER(LEN=*) :: name
728    LOGICAL,OPTIONAL          :: enabled
729  END SUBROUTINE xios_set_fieldgroup_attr
730
731  SUBROUTINE xios_set_filegroup_attr(name,enabled)
732    CHARACTER(LEN=*) :: name
733    LOGICAL,OPTIONAL          :: enabled
734  END SUBROUTINE xios_set_filegroup_attr
735
736  SUBROUTINE xios_get_axis_attr(name,n_glo,value)
737    CHARACTER(LEN=*) :: name
738    INTEGER,OPTIONAL          :: n_glo
739    REAL,OPTIONAL             :: value(:)
740  END SUBROUTINE xios_get_axis_attr
741
742#endif 
743
744END MODULE xios_mod
Note: See TracBrowser for help on using the repository browser.