source: trunk/LMDZ.PLUTO/libf/phypluto/xios_output_mod.F90

Last change on this file was 3506, checked in by afalco, 2 weeks ago

Pluto: import write_output function from Mars.
xios specific outputs.
AF
File size: 12.2 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,histwrite1d_xios,histwrite2d_xios,histwrite3d_xios
14 END INTERFACE
15
16
17CONTAINS
18
19  SUBROUTINE initialize_xios_output(day,timeofday,dtphys,daysec,yearday,   &
20                                    presnivs,pseudoalt,mlayer,wnoi,wnov)
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 ! length of a standard day (s)
39  REAL,INTENT(IN) :: yearday ! length of a standard year (day)
40  REAL,INTENT(IN) :: presnivs(:) ! vertical grid approximate pressure (Pa)
41  REAL,INTENT(IN) :: pseudoalt(:) ! vertical grid approximate altitude (km)
42  REAL,INTENT(IN) :: mlayer(:) ! soil layer depth at intermediate level (m)
43  REAL,INTENT(IN) :: wnoi(:) ! Array of wavenumbers at the spectral interval centers for the infrared.
44  real,intent(in) :: wnov (:) !Array of wavenumbers at the spectral interval centers for the visible.
45
46
47  INTEGER :: data_ibegin, data_iend
48  TYPE(xios_duration) :: timestep
49  TYPE(xios_date) :: time_origin
50  TYPE(xios_date) :: start_date
51
52!$OMP BARRIER
53!$OMP MASTER
54
55    ! 1. Declare available vertical axes to be used in output files:
56    IF (prt_level>=10) WRITE(lunout,*) "initialize_xios_output: call xios_set_axis_attr for presnivs"
57    CALL xios_set_axis_attr("presnivs", n_glo=size(presnivs), value=presnivs,&
58                            unit="Pa",positive="down")
59    IF (prt_level>=10) WRITE(lunout,*) "initialize_xios_output: call xios_set_axis_attr for altitude"
60    CALL xios_set_axis_attr("altitude", n_glo=size(pseudoalt), value=pseudoalt,&
61                            unit="km",positive="up")
62    CALL xios_set_axis_attr("interlayer", n_glo=size(pseudoalt)+1,&
63                            unit="km",positive="up")
64    IF (prt_level>=10) WRITE(lunout,*) "initialize_xios_output: call xios_set_axis_attr for soil"
65    CALL xios_set_axis_attr("soil_layers", n_glo=size(mlayer), value=mlayer,&
66                            unit="m",positive="down")
67    if (prt_level >=10) write(lunout,*) "initialize_xios_output: call xios_set_axis_attr for IR_Wavenumber"
68    write(lunout,*) "writing IR_Wavenumber now in initialize_xios_output"
69    call xios_set_axis_attr("IR_Wavenumber",n_glo=size(wnoi),value=wnoi, &
70                            unit="cm^-1",positive="up")
71    if (prt_level >=10) write(lunout,*) "initialize_xios_output: call xios_set_axis_attr for VI_Wavenumber"
72    write(lunout,*) "writing VI_Wavenumber now in initialize_xios_output"
73    call xios_set_axis_attr("VI_Wavenumber",n_glo=size(wnov),value=wnov, &
74                            unit="cm^-1",positive="up")
75    ! 2. Declare horizontal domain
76    ! Set values for the mask:
77!    IF (mpi_rank == 0) THEN
78!        data_ibegin = 0
79!    ELSE
80!        data_ibegin = ii_begin - 1
81!    END IF
82
83!    IF (mpi_rank == mpi_size-1) THEN
84!        data_iend = nbp_lon
85!    ELSE
86!        data_iend = ii_end + 1
87!    END IF
88
89!    if (prt_level>=10) then
90!      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
91!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
92!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
93!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
94!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
95!    endif
96
97!$OMP END MASTER
98!$OMP BARRIER
99    ! Initialize the XIOS domain coreesponding to this process:
100    if (prt_level>=10) write(lunout,*) "initialize_xios_output: call wxios_domain_param"
101!    CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
102!                            1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end,             &
103!                            klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend,             &
104!                            lat_reg*(180./pi), lon_reg*(180./pi),                       &
105!                            is_south_pole_dyn,mpi_rank)
106
107    IF (grid_type==unstructured) THEN
108      CALL wxios_domain_param_unstructured("dom_glo")
109    ELSE
110      CALL wxios_domain_param("dom_glo")
111    ENDIF
112
113!$OMP MASTER
114    ! 3. Declare calendar and time step
115    if (prt_level>=10) then
116     write(lunout,*) "initialize_xios_output: build calendar"
117    endif
118    timestep%second=1 !dtphys
119    if (nint(dtphys).ne.dtphys) then
120      write(*,*) "initialize_xios_output: warning physics timestep is not an integer!"
121    endif
122    if (nint(daysec).ne.daysec) then
123      write(*,*) "initialize_xios_output: warning day length is not an integer!"
124    endif
125    ! Important: do no operations involving dates and calendars
126    ! before defining the calendar!
127    CALL xios_define_calendar(type="user_defined", &
128                              timestep=timestep, &
129                              day_length=nint(daysec/dtphys), &
130                              month_lengths=[int(yearday)])
131                              !month_lengths=[30,30,30,30,30,30,30,30,30,30,30,30])
132    !NB: it would make more sense to define months and their length in the
133    ! xml files and not to have them hard coded here.... to be improved...
134
135    ! time origin of the simulation (default: 1st year/1st month/1st day, Ls=0)
136    time_origin=xios_date(1,1,1,0,0,0)
137    CALL xios_set_time_origin(time_origin=time_origin)
138!    if (prt_level>=10) then
139     write(lunout,*) "initialize_xios_output: time_origin=",time_origin
140!    endif
141
142    ! Now define the start time of this simulation
143    ! NB: we substract dtphys because we want to set the origin of the time axis
144    start_date=time_origin
145    call xios_set_start_date(start_date=start_date)
146    if (prt_level>=10) then
147     write(lunout,*) "initialize_xios_output: start_date=",start_date
148    endif
149
150    ! 4. Finalize the context:
151    if (prt_level>=10) write(*,*) "initialize_xios_output: call wxios_closedef"
152    CALL wxios_closedef()
153    if (prt_level>=10) write(*,*) "initialize_xios_output: after call wxios_closedef"
154
155!$OMP END MASTER
156!$OMP BARRIER
157
158  END SUBROUTINE initialize_xios_output
159
160!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
161
162  SUBROUTINE finalize_xios_output
163  USE xios
164  IMPLICIT NONE
165!$OMP BARRIER
166!$OMP MASTER
167    CALL xios_context_finalize
168!$OMP END MASTER
169!$OMP BARRIER
170
171  END SUBROUTINE finalize_xios_output
172
173!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
174
175  SUBROUTINE update_xios_timestep
176  USE xios
177  IMPLICIT NONE
178    CALL set_xios_context
179!$OMP MASTER
180    time_it=time_it+1
181    CALL xios_update_calendar(time_it)
182!$OMP END MASTER
183  END SUBROUTINE update_xios_timestep
184
185!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
186
187  SUBROUTINE set_xios_context
188  USE XIOS
189  IMPLICIT NONE
190    TYPE(xios_context) :: ctx_hdl
191
192!$OMP MASTER
193    CALL xios_get_handle(context_id,ctx_hdl)
194    CALL xios_set_current_context(ctx_hdl)
195!$OMP END MASTER
196  END SUBROUTINE set_xios_context
197
198!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
199
200  SUBROUTINE histwrite0d_xios(field_name,field)
201  USE xios, ONLY: xios_send_field
202  USE print_control_mod, ONLY: prt_level, lunout
203  IMPLICIT NONE
204
205    CHARACTER(LEN=*), INTENT(IN) :: field_name
206    REAL, INTENT(IN) :: field
207
208    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite0d_xios ',trim(field_name)
209
210!$OMP MASTER
211    CALL xios_send_field(field_name,field)
212!$OMP END MASTER
213
214    IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite0d_xios ',trim(field_name)
215
216  END SUBROUTINE histwrite0d_xios
217
218!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
219
220  SUBROUTINE histwrite1d_xios(field_name,field,dimens)
221  USE xios, ONLY: xios_send_field
222  USE print_control_mod, ONLY: prt_level, lunout
223  IMPLICIT NONE
224
225    CHARACTER(LEN=*), INTENT(IN) :: field_name
226    REAL, DIMENSION(:), INTENT(IN) :: field
227    INTEGER, INTENT(IN) :: dimens
228    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite1d_xios ',trim(field_name)
229!$OMP MASTER
230    CALL xios_send_field(field_name,field)
231!$OMP END MASTER
232
233    IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite1d_xios ',trim(field_name)
234
235  END SUBROUTINE histwrite1d_xios
236
237!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
238
239  SUBROUTINE histwrite2d_xios(field_name,field)
240  USE dimphy, only: klon
241  USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
242                                jj_nb, klon_mpi
243  USE xios, only: xios_send_field
244  USE print_control_mod, ONLY: prt_level, lunout
245  USE mod_grid_phy_lmdz, ONLY: nbp_lon
246  IMPLICIT NONE
247
248    CHARACTER(LEN=*), INTENT(IN) :: field_name
249    REAL, DIMENSION(:), INTENT(IN) :: field
250
251    REAL,DIMENSION(klon_mpi) :: buffer_omp
252    REAL :: Field2d(nbp_lon,jj_nb)
253
254    CHARACTER(len=128) :: msg
255
256    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',trim(field_name)
257    IF (SIZE(field)/=klon) THEN
258      WRITE(msg,*) "Pb with field "//trim(field_name)//&
259                   " : Field first DIMENSION not equal to klon"
260      CALL abort_physic('iophy::histwrite2d_xios',trim(msg),1)
261    ENDIF
262    CALL Gather_omp(field,buffer_omp)
263!$OMP MASTER
264    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
265
266    CALL xios_send_field(field_name, Field2d)
267!$OMP END MASTER
268
269    IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',trim(field_name)
270  END SUBROUTINE histwrite2d_xios
271
272!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
273
274  SUBROUTINE histwrite3d_xios(field_name, field)
275  USE dimphy, only: klon, klev
276  USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
277                                jj_nb, klon_mpi
278  USE xios, only: xios_send_field
279  USE print_control_mod, ONLY: prt_level,lunout
280  USE mod_grid_phy_lmdz, ONLY: nbp_lon
281
282  IMPLICIT NONE
283
284    CHARACTER(LEN=*), INTENT(IN) :: field_name
285    REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
286
287    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
288    REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
289    INTEGER :: ip, n, nlev
290
291    CHARACTER(len=128) :: msg
292
293  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',trim(field_name)
294
295    !And we write...
296    IF (SIZE(field,1)/=klon) THEN
297      WRITE(msg,*) "Pb with field "//trim(field_name)//&
298                   " : Field first DIMENSION not equal to klon"
299      CALL abort_physic('iophy::histwrite3d',trim(msg),1)
300    ENDIF
301
302    nlev=SIZE(field,2)
303
304
305    CALL Gather_omp(field,buffer_omp)
306!$OMP MASTER
307    CALL grid1Dto2D_mpi(buffer_omp,field3d)
308
309    CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
310!$OMP END MASTER
311
312    IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',trim(field_name)
313  END SUBROUTINE histwrite3d_xios
314
315!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
316
317 FUNCTION xios_is_active_field(field_id)
318 USE xios, only: xios_field_is_active
319 USE mod_phys_lmdz_omp_transfert, only: bcast_omp
320 IMPLICIT NONE
321   LOGICAL ::  xios_is_active_field
322   CHARACTER(LEN=*) :: field_id
323
324 ! check with XIOS if "field_id" is requested by the user
325 ! to be in the output file(s)
326
327!$OMP BARRIER
328!$OMP MASTER
329   xios_is_active_field = xios_field_is_active(field_id)
330!$OMP END MASTER
331   CALL bcast_omp(xios_is_active_field)
332 END FUNCTION xios_is_active_field
333
334#endif
335
336END MODULE xios_output_mod
Note: See TracBrowser for help on using the repository browser.