source: trunk/LMDZ.GENERIC/libf/phystd/xios_output_mod.F90

Last change on this file was 3522, checked in by afalco, 11 days ago

Generic PCM: imported write_output() subroutine from Mars PCM to write both diagfi and XIOS.

Still some bug on a few variables from generic condensation, to be checked.

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