source: trunk/LMDZ.MARS/libf/phymars/xios_output_mod.F90 @ 2223

Last change on this file since 2223 was 2223, checked in by emillour, 5 years ago

Mars GCM:
First implementation of XIOS in the physics
EM
File size: 9.5 KB
Line 
1MODULE xios_output_mod
2
3 IMPLICIT NONE
4 
5 INTEGER,PRIVATE,SAVE :: time_it=0 ! store number of iterations with calls to XIOS since start
6! does not need to be threadprivate; managed by omp master
7
8 CHARACTER(LEN=*), PARAMETER :: context_id= "LMDZ" ! same as in context_lmdz_physics.xml
9 
10#ifdef CPP_XIOS
11
12 INTERFACE send_xios_field
13    MODULE PROCEDURE histwrite0d_xios,histwrite2d_xios,histwrite3d_xios
14 END INTERFACE
15 
16
17CONTAINS
18
19  SUBROUTINE initialize_xios_output(day,timeofday,dtphys,daysec,&
20                                    presnivs,pseudoalt)
21  USE mod_phys_lmdz_para, ONLY: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
22                                mpi_size, mpi_rank, klon_mpi, &
23                                is_sequential, is_south_pole_dyn
24  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
25  USE print_control_mod, ONLY: lunout, prt_level
26  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
27  USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
28  USE nrtype, ONLY: pi
29#ifdef CPP_XIOS
30  USE xios
31#endif
32  USE wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_closedef
33  IMPLICIT NONE
34 
35  REAL,INTENT(IN) :: day ! Number of elapsed sols since reference Ls=0.
36  REAL,INTENT(IN) :: timeofday ! "Universal time", given as fraction of sol (e.g.: 0.5 for noon).
37  REAL,INTENT(IN) :: dtphys ! physics time step (s)
38  REAL,INTENT(IN) :: daysec ! lengthof a standard day (s)
39  REAL,INTENT(IN) :: presnivs(:) ! vertical grid approximate pressure (Pa)
40  REAL,INTENT(IN) :: pseudoalt(:) ! vertical grid approximate altitude (km)
41 
42 
43  INTEGER :: data_ibegin, data_iend
44  TYPE(xios_duration) :: timestep
45  TYPE(xios_date) :: time_origin
46  TYPE(xios_date) :: start_date
47 
48!$OMP BARRIER
49!$OMP MASTER
50
51    ! 1. Declare available vertical axes to be used in output files:
52    IF (prt_level>=10) WRITE(lunout,*) "initialize_xios_output: call xios_set_axis_attr for presnivs"
53    CALL xios_set_axis_attr("presnivs", n_glo=size(presnivs), value=presnivs,&
54                            unit="Pa",positive="down")
55    IF (prt_level>=10) WRITE(lunout,*) "initialize_xios_output: call xios_set_axis_attr for altitude"
56    CALL xios_set_axis_attr("altitude", n_glo=size(pseudoalt), value=pseudoalt,&
57                            unit="km",positive="up")
58   
59    ! 2. Declare horizontal domain
60    ! Set values for the mask:
61!    IF (mpi_rank == 0) THEN
62!        data_ibegin = 0
63!    ELSE
64!        data_ibegin = ii_begin - 1
65!    END IF
66
67!    IF (mpi_rank == mpi_size-1) THEN
68!        data_iend = nbp_lon
69!    ELSE
70!        data_iend = ii_end + 1
71!    END IF
72
73!    if (prt_level>=10) then
74!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
75!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
76!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
77!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
78!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
79!    endif
80
81!$OMP END MASTER
82!$OMP BARRIER
83    ! Initialize the XIOS domain coreesponding to this process:
84    if (prt_level>=10) write(lunout,*) "initialize_xios_output: call wxios_domain_param"
85!    CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
86!                            1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end,             &
87!                            klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend,             &
88!                            lat_reg*(180./pi), lon_reg*(180./pi),                       &
89!                            is_south_pole_dyn,mpi_rank)
90
91    IF (grid_type==unstructured) THEN
92      CALL wxios_domain_param_unstructured("dom_glo")
93    ELSE
94      CALL wxios_domain_param("dom_glo")
95    ENDIF
96
97!$OMP MASTER
98    ! 3. Declare calendar and time step
99    if (prt_level>=10) then
100     write(lunout,*) "initialize_xios_output: build calendar"
101    endif
102    timestep%second=dtphys
103    if (nint(dtphys).ne.dtphys) then
104      write(*,*) "initialize_xios_output: warning physics timestep is not an integer!"
105      timestep%second=nint(dtphys)
106    endif
107    if (nint(daysec).ne.daysec) then
108      write(*,*) "initialize_xios_output: warning day length is not an integer!"
109    endif
110    ! Important: do no operations involving dates and calendars
111    ! before defining the calendar!
112    CALL xios_define_calendar(type="user_defined", &
113                              timestep=timestep, &
114                              day_length=nint(daysec), &
115                              month_lengths=[61,66,66,65,60,54,50,46,47,47,51,56])
116    !NB: it would make more sense to define months and their length in the
117    ! xml files and not to have them hard coded here.... to be improved...
118   
119    ! time origin of the simulation (default: 1st year/1st month/1st day, Ls=0)
120    time_origin=xios_date(1,1,1,0,0,0)
121    CALL xios_set_time_origin(time_origin=time_origin)
122!    if (prt_level>=10) then
123     write(lunout,*) "initialize_xios_output: time_origin=",time_origin
124!    endif
125
126    ! Now define the start time of this simulation
127    ! NB: we substract dtphys because we want to set the origin of the time axis
128    start_date=time_origin+xios_duration(0,0,day,0,0,timeofday*daysec-dtphys)
129    call xios_set_start_date(start_date=start_date)
130    if (prt_level>=10) then
131     write(lunout,*) "initialize_xios_output: start_date=",start_date
132    endif
133
134    ! 4. Finalize the context:
135    if (prt_level>=10) write(*,*) "initialize_xios_output: call wxios_closedef"
136    CALL wxios_closedef()
137    if (prt_level>=10) write(*,*) "initialize_xios_output: after call wxios_closedef"
138
139!$OMP END MASTER
140!$OMP BARRIER
141 
142  END SUBROUTINE initialize_xios_output
143
144!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
145
146  SUBROUTINE finalize_xios_output
147  USE xios
148  IMPLICIT NONE
149!$OMP BARRIER   
150!$OMP MASTER
151    CALL xios_context_finalize
152!$OMP END MASTER   
153!$OMP BARRIER   
154 
155  END SUBROUTINE finalize_xios_output
156
157!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
158
159  SUBROUTINE update_xios_timestep
160  USE xios
161  IMPLICIT NONE
162    CALL set_xios_context
163!$OMP MASTER
164    time_it=time_it+1
165    CALL xios_update_calendar(time_it)
166!$OMP END MASTER   
167  END SUBROUTINE update_xios_timestep
168
169!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
170
171  SUBROUTINE set_xios_context
172  USE XIOS
173  IMPLICIT NONE
174    TYPE(xios_context) :: ctx_hdl
175
176!$OMP MASTER
177    CALL xios_get_handle(context_id,ctx_hdl)
178    CALL xios_set_current_context(ctx_hdl)
179!$OMP END MASTER   
180  END SUBROUTINE set_xios_context
181
182!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
183
184  SUBROUTINE histwrite0d_xios(field_name,field)
185  USE xios, ONLY: xios_send_field
186  USE print_control_mod, ONLY: prt_level, lunout
187  IMPLICIT NONE
188 
189    CHARACTER(LEN=*), INTENT(IN) :: field_name
190    REAL, INTENT(IN) :: field
191   
192    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite0d_xios ',trim(field_name)
193   
194!$OMP MASTER
195    CALL xios_send_field(field_name,field)
196!$OMP END MASTER
197   
198    IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite0d_xios ',trim(field_name)
199   
200  END SUBROUTINE histwrite0d_xios
201
202!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
203
204  SUBROUTINE histwrite2d_xios(field_name,field)
205  USE dimphy, only: klon
206  USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
207                                jj_nb, klon_mpi
208  USE xios, only: xios_send_field
209  USE print_control_mod, ONLY: prt_level, lunout
210  USE mod_grid_phy_lmdz, ONLY: nbp_lon
211  IMPLICIT NONE
212
213    CHARACTER(LEN=*), INTENT(IN) :: field_name
214    REAL, DIMENSION(:), INTENT(IN) :: field
215     
216    REAL,DIMENSION(klon_mpi) :: buffer_omp
217    REAL :: Field2d(nbp_lon,jj_nb)
218
219    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',trim(field_name)
220
221    IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon',1)
222   
223    CALL Gather_omp(field,buffer_omp)   
224!$OMP MASTER
225    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
226   
227    CALL xios_send_field(field_name, Field2d)
228!$OMP END MASTER   
229
230    IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',trim(field_name)
231  END SUBROUTINE histwrite2d_xios
232
233!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
234
235  SUBROUTINE histwrite3d_xios(field_name, field)
236  USE dimphy, only: klon, klev
237  USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
238                                jj_nb, klon_mpi
239  USE xios, only: xios_send_field
240  USE print_control_mod, ONLY: prt_level,lunout
241  USE mod_grid_phy_lmdz, ONLY: nbp_lon
242
243  IMPLICIT NONE
244
245    CHARACTER(LEN=*), INTENT(IN) :: field_name
246    REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
247
248    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
249    REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
250    INTEGER :: ip, n, nlev
251
252  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',trim(field_name)
253
254    !Et on.... écrit
255    IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
256    nlev=SIZE(field,2)
257
258
259    CALL Gather_omp(field,buffer_omp)
260!$OMP MASTER
261    CALL grid1Dto2D_mpi(buffer_omp,field3d)
262
263    CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
264!$OMP END MASTER   
265
266    IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',trim(field_name)
267  END SUBROUTINE histwrite3d_xios
268
269#endif
270
271END MODULE xios_output_mod
Note: See TracBrowser for help on using the repository browser.