source: trunk/LMDZ.TITAN/libf/phytitan/xios_output_mod.F90 @ 3567

Last change on this file since 3567 was 3318, checked in by slebonnois, 8 months ago

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