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

Last change on this file since 2632 was 2632, checked in by dbardet, 3 years ago

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