Context Navigation

iophy.F90 @ 3450

Last change on this file since 3450 was 3435, checked in by Laurent Fairhead, 6 years ago

"Historic" :-) commit merging the physics branch used for DYNAMICO with the LMDZ trunk.
The same physics branch can now be used seamlessly with the traditional lon-lat LMDZ
dynamical core and DYNAMICO.
Testing consisted in running a lon-lat LMDZ bucket simulation with the NPv6.1 physics package
with the original trunk sources and the merged sources. Tests were succesful in the sense that
numeric continuity was preserved in the restart files from both simulation. Further tests
included running both versions of the physics codes for one year in a LMDZOR setting in which
the restart files also came out identical.

Caution:

as the physics package now manages unstructured grids, grid information needs to be transmitted

to the surface scheme ORCHIDEE. This means that the interface defined in surf_land_orchidee_mod.F90
is only compatible with ORCHIDEE version orchidee2.1 and later versions. If previous versions of
ORCHIDEE need to be used, the CPP key ORCHIDEE_NOUNSTRUCT needs to be set at compilation time.
This is done automatically if makelmdz/makelmdz_fcm are called with the veget orchidee2.0 switch

due to a limitation in XIOS, the time at which limit conditions will be read in by DYNAMICO will be

delayed by one physic timestep with respect to the time it is read in by the lon-lat model. This is caused
by the line

IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN ! time to read

in limit_read_mod.F90

Work still needed on COSP integration and XML files for DYNAMICO

EM, YM, LF

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory
Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 51.1 KB

Line
1	!
2	! $Id: iophy.F90 3435 2019-01-22 15:21:59Z oboucher $
3	!
4	MODULE iophy
5
6	! abd REAL,private,allocatable,DIMENSION(:),save :: io_lat
7	! abd REAL,private,allocatable,DIMENSION(:),save :: io_lon
8	REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lat
9	REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lon
10	INTEGER, SAVE :: phys_domain_id
11	INTEGER, SAVE :: npstn
12	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nptabij
13	INTEGER, SAVE :: itau_iophy
14	LOGICAL :: check_dim = .false.
15
16	!$OMP THREADPRIVATE(itau_iophy)
17
18	#ifdef CPP_XIOS
19	INTERFACE histwrite_phy
20	MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios,histwrite0d_xios
21	END INTERFACE
22	#else
23	INTERFACE histwrite_phy
24	MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old
25	END INTERFACE
26	#endif
27
28	INTERFACE histbeg_phy_all
29	MODULE PROCEDURE histbeg_phy,histbeg_phyxios,histbeg_phy_points
30	END INTERFACE
31
32
33	CONTAINS
34
35	! ug Routine pour définir itau_iophy depuis phys_output_write_mod:
36	SUBROUTINE set_itau_iophy(ito)
37	IMPLICIT NONE
38	INTEGER, INTENT(IN) :: ito
39	itau_iophy = ito
40	END SUBROUTINE
41
42	SUBROUTINE init_iophy_new(rlat,rlon)
43
44	USE dimphy, ONLY: klon
45	USE mod_phys_lmdz_para, ONLY: gather, bcast, &
46	jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
47	mpi_size, mpi_rank, klon_mpi, &
48	is_sequential, is_south_pole_dyn
49	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
50	USE print_control_mod, ONLY: prt_level,lunout
51	#ifdef CPP_IOIPSL
52	USE ioipsl, ONLY: flio_dom_set
53	#endif
54	#ifdef CPP_XIOS
55	use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init
56	#endif
57	IMPLICIT NONE
58	REAL,DIMENSION(klon),INTENT(IN) :: rlon
59	REAL,DIMENSION(klon),INTENT(IN) :: rlat
60
61	REAL,DIMENSION(klon_glo) :: rlat_glo
62	REAL,DIMENSION(klon_glo) :: rlon_glo
63
64	INTEGER,DIMENSION(2) :: ddid
65	INTEGER,DIMENSION(2) :: dsg
66	INTEGER,DIMENSION(2) :: dsl
67	INTEGER,DIMENSION(2) :: dpf
68	INTEGER,DIMENSION(2) :: dpl
69	INTEGER,DIMENSION(2) :: dhs
70	INTEGER,DIMENSION(2) :: dhe
71	INTEGER :: i
72	INTEGER :: data_ibegin, data_iend
73
74	#ifdef CPP_XIOS
75	CALL wxios_context_init
76	#endif
77
78
79	IF (grid_type==unstructured) THEN
80
81	#ifdef CPP_XIOS
82	CALL wxios_domain_param_unstructured("dom_glo")
83	#endif
84
85	ELSE
86
87	CALL gather(rlat,rlat_glo)
88	CALL bcast(rlat_glo)
89	CALL gather(rlon,rlon_glo)
90	CALL bcast(rlon_glo)
91
92	!$OMP MASTER
93	ALLOCATE(io_lat(nbp_lat))
94	IF (klon_glo == 1) THEN
95	io_lat(1)=rlat_glo(1)
96	ELSE
97	io_lat(1)=rlat_glo(1)
98	io_lat(nbp_lat)=rlat_glo(klon_glo)
99	DO i=2,nbp_lat-1
100	io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
101	ENDDO
102	ENDIF
103
104	ALLOCATE(io_lon(nbp_lon))
105	IF (klon_glo == 1) THEN
106	io_lon(1)=rlon_glo(1)
107	ELSE
108	io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1)
109	ENDIF
110
111	!! (I) dtnb : total number of domains
112	!! (I) dnb : domain number
113	!! (I) did(:) : distributed dimensions identifiers
114	!! (up to 5 dimensions are supported)
115	!! (I) dsg(:) : total number of points for each dimension
116	!! (I) dsl(:) : local number of points for each dimension
117	!! (I) dpf(:) : position of first local point for each dimension
118	!! (I) dpl(:) : position of last local point for each dimension
119	!! (I) dhs(:) : start halo size for each dimension
120	!! (I) dhe(:) : end halo size for each dimension
121	!! (C) cdnm : Model domain definition name.
122	!! The names actually supported are :
123	!! "BOX", "APPLE", "ORANGE".
124	!! These names are case insensitive.
125
126	ddid=(/ 1,2 /)
127	dsg=(/ nbp_lon, nbp_lat /)
128	dsl=(/ nbp_lon, jj_nb /)
129	dpf=(/ 1,jj_begin /)
130	dpl=(/ nbp_lon, jj_end /)
131	dhs=(/ ii_begin-1,0 /)
132	IF (mpi_rank==mpi_size-1) THEN
133	dhe=(/0,0/)
134	ELSE
135	dhe=(/ nbp_lon-ii_end,0 /)
136	ENDIF
137
138	#ifndef CPP_IOIPSL_NO_OUTPUT
139	CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
140	'APPLE',phys_domain_id)
141	#endif
142	#ifdef CPP_XIOS
143	! Set values for the mask:
144	IF (mpi_rank == 0) THEN
145	data_ibegin = 0
146	ELSE
147	data_ibegin = ii_begin - 1
148	END IF
149
150	IF (mpi_rank == mpi_size-1) THEN
151	data_iend = nbp_lon
152	ELSE
153	data_iend = ii_end + 1
154	END IF
155
156	IF (prt_level>=10) THEN
157	write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
158	write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
159	write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
160	write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
161	write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole_dyn=",is_south_pole_dyn
162	ENDIF
163
164	! Initialize the XIOS domain coreesponding to this process:
165	#endif
166	!$OMP END MASTER
167
168	#ifdef CPP_XIOS
169	CALL wxios_domain_param("dom_glo")
170	#endif
171
172	ENDIF
173
174	END SUBROUTINE init_iophy_new
175
176
177	SUBROUTINE init_iophy(lat,lon)
178
179	USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
180	mpi_size, mpi_rank
181	USE ioipsl, ONLY: flio_dom_set
182	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
183
184	IMPLICIT NONE
185
186	REAL,DIMENSION(nbp_lon),INTENT(IN) :: lon
187	REAL,DIMENSION(nbp_lat),INTENT(IN) :: lat
188
189	INTEGER,DIMENSION(2) :: ddid
190	INTEGER,DIMENSION(2) :: dsg
191	INTEGER,DIMENSION(2) :: dsl
192	INTEGER,DIMENSION(2) :: dpf
193	INTEGER,DIMENSION(2) :: dpl
194	INTEGER,DIMENSION(2) :: dhs
195	INTEGER,DIMENSION(2) :: dhe
196
197	!$OMP MASTER
198	ALLOCATE(io_lat(nbp_lat))
199	io_lat(:)=lat(:)
200	ALLOCATE(io_lon(nbp_lon))
201	io_lon(:)=lon(:)
202
203	ddid=(/ 1,2 /)
204	dsg=(/ nbp_lon, nbp_lat /)
205	dsl=(/ nbp_lon, jj_nb /)
206	dpf=(/ 1,jj_begin /)
207	dpl=(/ nbp_lon, jj_end /)
208	dhs=(/ ii_begin-1,0 /)
209	IF (mpi_rank==mpi_size-1) THEN
210	dhe=(/0,0/)
211	ELSE
212	dhe=(/ nbp_lon-ii_end,0 /)
213	ENDIF
214
215	#ifndef CPP_IOIPSL_NO_OUTPUT
216	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
217	'APPLE',phys_domain_id)
218	#endif
219	!$OMP END MASTER
220
221	END SUBROUTINE init_iophy
222
223	SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day)
224	! USE dimphy
225	USE mod_phys_lmdz_para, ONLY: is_sequential, is_using_mpi, is_mpi_root, &
226	jj_begin, jj_end, jj_nb
227	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
228	USE ioipsl, ONLY: histbeg
229	#ifdef CPP_XIOS
230	USE wxios, ONLY: wxios_add_file
231	#endif
232	IMPLICIT NONE
233	INCLUDE 'clesphys.h'
234
235	CHARACTER(), INTENT(IN) :: name
236	INTEGER, INTENT(IN) :: itau0
237	REAL,INTENT(IN) :: zjulian
238	REAL,INTENT(IN) :: dtime
239	CHARACTER(LEN=*), INTENT(IN) :: ffreq
240	INTEGER,INTENT(IN) :: lev
241	INTEGER,INTENT(OUT) :: nhori
242	INTEGER,INTENT(OUT) :: nid_day
243
244	!$OMP MASTER
245	IF (is_sequential) THEN
246	CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
247	1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
248	ELSE
249	CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
250	1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
251	ENDIF
252
253	#ifdef CPP_XIOS
254	! ug OMP en chantier...
255	IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN
256	! ug Création du fichier
257	IF (.not. ok_all_xml) THEN
258	CALL wxios_add_file(name, ffreq, lev)
259	ENDIF
260	ENDIF
261	#endif
262	!$OMP END MASTER
263
264	END SUBROUTINE histbeg_phyxios
265
266	SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
267
268	USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, jj_nb, is_sequential
269	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
270	USE ioipsl, ONLY: histbeg
271
272	IMPLICIT NONE
273
274	CHARACTER(), INTENT(IN) :: name
275	INTEGER, INTENT(IN) :: itau0
276	REAL,INTENT(IN) :: zjulian
277	REAL,INTENT(IN) :: dtime
278	INTEGER,INTENT(OUT) :: nhori
279	INTEGER,INTENT(OUT) :: nid_day
280
281	!$OMP MASTER
282	#ifndef CPP_IOIPSL_NO_OUTPUT
283	IF (is_sequential) THEN
284	CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
285	1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
286	ELSE
287	CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
288	1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
289	ENDIF
290	#endif
291	!$OMP END MASTER
292
293	END SUBROUTINE histbeg_phy
294
295
296	SUBROUTINE histbeg_phy_points(rlon,rlat,pim,tabij,ipt,jpt, &
297	plon,plat,plon_bounds,plat_bounds, &
298	nname,itau0,zjulian,dtime,nnhori,nnid_day)
299	USE dimphy, ONLY: klon
300	USE mod_phys_lmdz_para, ONLY: gather, bcast, &
301	is_sequential, klon_mpi_begin, klon_mpi_end, &
302	mpi_rank
303	USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dTo2d_glo
304	USE ioipsl, ONLY: histbeg
305
306	IMPLICIT NONE
307
308	REAL,DIMENSION(klon),INTENT(IN) :: rlon
309	REAL,DIMENSION(klon),INTENT(IN) :: rlat
310	INTEGER, INTENT(IN) :: itau0
311	REAL,INTENT(IN) :: zjulian
312	REAL,INTENT(IN) :: dtime
313	INTEGER, INTENT(IN) :: pim
314	INTEGER, intent(out) :: nnhori
315	CHARACTER(len=20), INTENT(IN) :: nname
316	INTEGER, INTENT(OUT) :: nnid_day
317	INTEGER :: i
318	REAL,DIMENSION(klon_glo) :: rlat_glo
319	REAL,DIMENSION(klon_glo) :: rlon_glo
320	INTEGER, DIMENSION(pim), INTENT(IN) :: tabij
321	REAL,DIMENSION(pim), INTENT(IN) :: plat, plon
322	INTEGER,DIMENSION(pim), INTENT(IN) :: ipt, jpt
323	REAL,DIMENSION(pim,2), intent(out) :: plat_bounds, plon_bounds
324
325	INTEGER, SAVE :: tabprocbeg, tabprocend
326	!$OMP THREADPRIVATE(tabprocbeg, tabprocend)
327	INTEGER :: ip
328	INTEGER, PARAMETER :: nip=1
329	INTEGER :: npproc
330	REAL, allocatable, DIMENSION(:) :: npplat, npplon
331	REAL, allocatable, DIMENSION(:,:) :: npplat_bounds, npplon_bounds
332	REAL, DIMENSION(nbp_lon,nbp_lat) :: zx_lon, zx_lat
333
334	CALL gather(rlat,rlat_glo)
335	CALL bcast(rlat_glo)
336	CALL gather(rlon,rlon_glo)
337	CALL bcast(rlon_glo)
338
339	!$OMP MASTER
340	DO i=1,pim
341
342	! print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i)
343
344	plon_bounds(i,1)=rlon_glo(tabij(i)-1)
345	plon_bounds(i,2)=rlon_glo(tabij(i)+1)
346	IF (plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN
347	IF (rlon_glo(tabij(i)).GE.0.) THEN
348	plon_bounds(i,2)=-1*plon_bounds(i,2)
349	ENDIF
350	ENDIF
351	IF (plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN
352	IF (rlon_glo(tabij(i)).LE.0.) THEN
353	plon_bounds(i,2)=-1*plon_bounds(i,2)
354	ENDIF
355	ENDIF
356	!
357	IF ( tabij(i).LE.nbp_lon) THEN
358	plat_bounds(i,1)=rlat_glo(tabij(i))
359	ELSE
360	plat_bounds(i,1)=rlat_glo(tabij(i)-nbp_lon)
361	ENDIF
362	plat_bounds(i,2)=rlat_glo(tabij(i)+nbp_lon)
363	!
364	! print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon_glo(tabij(i)),plon_bounds(i,2)
365	! print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat_glo(tabij(i)),plat_bounds(i,2)
366	!
367	ENDDO
368	if (is_sequential) then
369
370	npstn=pim
371	IF(.NOT. ALLOCATED(nptabij)) THEN
372	ALLOCATE(nptabij(pim))
373	ENDIF
374	DO i=1,pim
375	nptabij(i)=tabij(i)
376	ENDDO
377
378	CALL grid1dTo2d_glo(rlon_glo,zx_lon)
379	IF ((nbp_lon*nbp_lat).GT.1) THEN
380	DO i = 1, nbp_lon
381	zx_lon(i,1) = rlon_glo(i+1)
382	zx_lon(i,nbp_lat) = rlon_glo(i+1)
383	ENDDO
384	ENDIF
385	CALL grid1dTo2d_glo(rlat_glo,zx_lat)
386
387	DO i=1,pim
388	! print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i)
389
390	plon_bounds(i,1)=zx_lon(ipt(i)-1,jpt(i))
391	plon_bounds(i,2)=zx_lon(ipt(i)+1,jpt(i))
392
393	IF (ipt(i).EQ.1) THEN
394	plon_bounds(i,1)=zx_lon(nbp_lon,jpt(i))
395	plon_bounds(i,2)=360.+zx_lon(ipt(i)+1,jpt(i))
396	ENDIF
397
398	IF (ipt(i).EQ.nbp_lon) THEN
399	plon_bounds(i,2)=360.+zx_lon(1,jpt(i))
400	ENDIF
401
402	plat_bounds(i,1)=zx_lat(ipt(i),jpt(i)-1)
403	plat_bounds(i,2)=zx_lat(ipt(i),jpt(i)+1)
404
405	IF (jpt(i).EQ.1) THEN
406	plat_bounds(i,1)=zx_lat(ipt(i),1)+0.001
407	plat_bounds(i,2)=zx_lat(ipt(i),1)-0.001
408	ENDIF
409
410	IF (jpt(i).EQ.nbp_lat) THEN
411	plat_bounds(i,1)=zx_lat(ipt(i),nbp_lat)+0.001
412	plat_bounds(i,2)=zx_lat(ipt(i),nbp_lat)-0.001
413	ENDIF
414	!
415	! print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon(tabij(i)),plon_bounds(i,2)
416	! print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat(tabij(i)),plat_bounds(i,2)
417	!
418	ENDDO
419
420	#ifndef CPP_IOIPSL_NO_OUTPUT
421	CALL histbeg(nname,pim,plon,plon_bounds, &
422	plat,plat_bounds, &
423	itau0, zjulian, dtime, nnhori, nnid_day)
424	#endif
425	ELSE
426	npproc=0
427	DO ip=1, pim
428	tabprocbeg=klon_mpi_begin
429	tabprocend=klon_mpi_end
430	IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN
431	npproc=npproc+1
432	npstn=npproc
433	ENDIF
434	ENDDO
435	! print*,'CFMIP_iophy mpi_rank npstn',mpi_rank,npstn
436	IF(.NOT. ALLOCATED(nptabij)) THEN
437	ALLOCATE(nptabij(npstn))
438	ALLOCATE(npplon(npstn), npplat(npstn))
439	ALLOCATE(npplon_bounds(npstn,2), npplat_bounds(npstn,2))
440	ENDIF
441	npproc=0
442	DO ip=1, pim
443	IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN
444	npproc=npproc+1
445	nptabij(npproc)=tabij(ip)
446	! print*,'mpi_rank npproc ip plon plat tabij=',mpi_rank,npproc,ip, &
447	! plon(ip),plat(ip),tabij(ip)
448	npplon(npproc)=plon(ip)
449	npplat(npproc)=plat(ip)
450	npplon_bounds(npproc,1)=plon_bounds(ip,1)
451	npplon_bounds(npproc,2)=plon_bounds(ip,2)
452	npplat_bounds(npproc,1)=plat_bounds(ip,1)
453	npplat_bounds(npproc,2)=plat_bounds(ip,2)
454	!!!
455	!!! print qui sert a reordonner les points stations selon l'ordre CFMIP
456	!!! ne pas enlever
457	print*,'iophy_mpi rank ip lon lat',mpi_rank,ip,plon(ip),plat(ip)
458	!!!
459	ENDIF
460	ENDDO
461	#ifndef CPP_IOIPSL_NO_OUTPUT
462	CALL histbeg(nname,npstn,npplon,npplon_bounds, &
463	npplat,npplat_bounds, &
464	itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id)
465	#endif
466	ENDIF
467	!$OMP END MASTER
468
469	END SUBROUTINE histbeg_phy_points
470
471
472	SUBROUTINE histdef2d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
473
474	USE ioipsl, ONLY: histdef
475	USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
476	USE phys_output_var_mod, ONLY: type_ecri, zoutm, zdtime_moy, lev_files, &
477	nid_files, nhorim, swaero_diag, dryaod_diag, nfiles, &
478	ok_4xCO2atm
479	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
480	USE aero_mod, ONLY : naero_tot, name_aero_tau
481	USE print_control_mod, ONLY: prt_level,lunout
482
483	IMPLICIT NONE
484
485	INCLUDE "clesphys.h"
486
487	INTEGER :: iff
488	INTEGER :: naero
489	LOGICAL :: lpoint
490	INTEGER, DIMENSION(nfiles) :: flag_var
491	CHARACTER(LEN=20) :: nomvar
492	CHARACTER(LEN=*) :: titrevar
493	CHARACTER(LEN=*) :: unitvar
494
495	REAL zstophym
496
497	IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
498	zstophym=zoutm(iff)
499	ELSE
500	zstophym=zdtime_moy
501	ENDIF
502	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d_old for ', nomvar
503	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
504	CALL conf_physoutputs(nomvar,flag_var)
505
506	IF(.NOT.lpoint) THEN
507	IF ( flag_var(iff)<=lev_files(iff) ) THEN
508	CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
509	nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
510	type_ecri(iff), zstophym,zoutm(iff))
511	ENDIF
512	ELSE
513	IF ( flag_var(iff)<=lev_files(iff) ) THEN
514	CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
515	npstn,1,nhorim(iff), 1,1,1, -99, 32, &
516	type_ecri(iff), zstophym,zoutm(iff))
517	ENDIF
518	ENDIF
519
520	! Set swaero_diag=true if at least one of the concerned variables are defined
521	IF (nomvar=='topswad' .OR. nomvar=='topswad0' .OR. nomvar=='solswad' .OR. nomvar=='solswad0' .OR. &
522	nomvar=='toplwad' .OR. nomvar=='toplwad0' .OR. nomvar=='sollwad' .OR. nomvar=='sollwad0' .OR. &
523	nomvar=='topswai' .OR. nomvar=='solswai' ) THEN
524	IF ( flag_var(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
525	ENDIF
526
527	! Set dryaod_diag=true if at least one of the concerned variables are defined
528	IF (nomvar=='dryod550aer') THEN
529	IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
530	ENDIF
531	DO naero = 1, naero_tot-1
532	IF (nomvar=='dryod550_'//name_aero_tau(naero)) THEN
533	IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
534	ENDIF
535	ENDDO
536
537	! Set ok_4xCO2atm=true if at least one of the concerned variables are
538	! defined
539	IF (nomvar=='rsut4co2'.OR.nomvar=='rlut4co2'.OR.nomvar=='rsutcs4co2' &
540	.OR. nomvar=='rlutcs4co2'.OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2' &
541	.OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2'.OR.nomvar=='rsd4co2'.OR. &
542	nomvar=='rsdcs4co2'.OR.nomvar=='rlu4co2'.OR.nomvar=='rlucs4co2'.OR.&
543	nomvar=='rld4co2'.OR.nomvar=='rldcs4co2') THEN
544	IF ( flag_var(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE.
545	ENDIF
546	END SUBROUTINE histdef2d_old
547
548	SUBROUTINE histdef3d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
549
550	USE ioipsl, ONLY: histdef
551	USE dimphy, ONLY: klev
552	USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
553	USE phys_output_var_mod, ONLY: type_ecri, zoutm, lev_files, nid_files, &
554	nhorim, zdtime_moy, levmin, levmax, &
555	nvertm, nfiles
556	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
557	USE print_control_mod, ONLY: prt_level,lunout
558	IMPLICIT NONE
559
560	INCLUDE "clesphys.h"
561
562	INTEGER :: iff
563	LOGICAL :: lpoint
564	INTEGER, DIMENSION(nfiles) :: flag_var
565	CHARACTER(LEN=20) :: nomvar
566	CHARACTER(LEN=*) :: titrevar
567	CHARACTER(LEN=*) :: unitvar
568
569	REAL zstophym
570
571	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
572	CALL conf_physoutputs(nomvar,flag_var)
573
574	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d_old for ', nomvar
575
576	IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
577	zstophym=zoutm(iff)
578	ELSE
579	zstophym=zdtime_moy
580	ENDIF
581
582	IF(.NOT.lpoint) THEN
583	IF ( flag_var(iff)<=lev_files(iff) ) THEN
584	CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
585	nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), &
586	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, type_ecri(iff), &
587	zstophym, zoutm(iff))
588	ENDIF
589	ELSE
590	IF ( flag_var(iff)<=lev_files(iff) ) THEN
591	CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
592	npstn,1,nhorim(iff), klev, levmin(iff), &
593	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
594	type_ecri(iff), zstophym,zoutm(iff))
595	ENDIF
596	ENDIF
597	END SUBROUTINE histdef3d_old
598
599	SUBROUTINE histdef2d (iff,var)
600
601	USE ioipsl, ONLY: histdef
602	USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
603	USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
604	clef_stations, phys_out_filenames, lev_files, &
605	nid_files, nhorim, swaerofree_diag, swaero_diag, dryaod_diag,&
606	ok_4xCO2atm
607	USE print_control_mod, ONLY: prt_level,lunout
608	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
609	USE aero_mod, ONLY : naero_tot, name_aero_tau
610	#ifdef CPP_XIOS
611	USE wxios, ONLY: wxios_add_field_to_file
612	#endif
613	USE print_control_mod, ONLY: prt_level,lunout
614	IMPLICIT NONE
615
616	INCLUDE "clesphys.h"
617
618	INTEGER :: iff
619	INTEGER :: naero
620	TYPE(ctrl_out) :: var
621
622	REAL zstophym
623	CHARACTER(LEN=20) :: typeecrit
624
625	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d for ', var%name
626
627	! ug On récupère le type écrit de la structure:
628	! Assez moche, à refaire si meilleure méthode...
629	IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
630	typeecrit = 'once'
631	ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
632	typeecrit = 't_min(X)'
633	ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
634	typeecrit = 't_max(X)'
635	ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
636	typeecrit = 'inst(X)'
637	ELSE
638	typeecrit = type_ecri_files(iff)
639	ENDIF
640
641	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
642	zstophym=zoutm(iff)
643	ELSE
644	zstophym=zdtime_moy
645	ENDIF
646
647	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
648	CALL conf_physoutputs(var%name, var%flag)
649
650	IF(.NOT.clef_stations(iff)) THEN
651
652	#ifdef CPP_XIOS
653	IF (.not. ok_all_xml) THEN
654	IF ( var%flag(iff)<=lev_files(iff) ) THEN
655	CALL wxios_add_field_to_file(var%name, 2, iff, phys_out_filenames(iff), &
656	var%description, var%unit, var%flag(iff), typeecrit)
657	IF (prt_level >= 10) THEN
658	WRITE(lunout,*) 'histdef2d: call wxios_add_field_to_file var%name iff: ', &
659	trim(var%name),iff
660	ENDIF
661	ENDIF
662	ENDIF
663	#endif
664	#ifndef CPP_IOIPSL_NO_OUTPUT
665
666	IF ( var%flag(iff)<=lev_files(iff) ) THEN
667	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
668	nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
669	typeecrit, zstophym,zoutm(iff))
670	ENDIF
671	ELSE
672	IF ( var%flag(iff)<=lev_files(iff)) THEN
673	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
674	npstn,1,nhorim(iff), 1,1,1, -99, 32, &
675	typeecrit, zstophym,zoutm(iff))
676	ENDIF
677	#endif
678	ENDIF
679
680	! Set swaero_diag=true if at least one of the concerned variables are defined
681	!--OB 30/05/2016 use wider set of variables
682	IF ( var%name=='topswad' .OR. var%name=='topswad0' .OR. var%name=='solswad' .OR. var%name=='solswad0' .OR. &
683	var%name=='topswai' .OR. var%name=='solswai' .OR. ( iflag_rrtm==1 .AND. ( &
684	var%name=='toplwad' .OR. var%name=='toplwad0' .OR. var%name=='sollwad' .OR. var%name=='sollwad0' .OR. &
685	var%name=='toplwai' .OR. var%name=='sollwai' ) ) ) THEN
686	IF ( var%flag(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
687	ENDIF
688
689	! Set swaerofree_diag=true if at least one of the concerned variables are defined
690	IF (var%name=='SWupTOAcleanclr' .OR. var%name=='SWupSFCcleanclr' .OR. var%name=='SWdnSFCcleanclr' .OR. &
691	var%name=='LWupTOAcleanclr' .OR. var%name=='LWdnSFCcleanclr' ) THEN
692	IF ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
693	ENDIF
694
695	! set dryaod_dry=true if at least one of the concerned variables are defined
696	IF (var%name=='dryod550aer') THEN
697	IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
698	ENDIF
699	!
700	DO naero = 1, naero_tot-1
701	IF (var%name=='dryod550_'//name_aero_tau(naero)) THEN
702	IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
703	ENDIF
704	ENDDO
705	! Set ok_4xCO2atm=true if at least one of the concerned variables are
706	! defined
707	IF (var%name=='rsut4co2'.OR.var%name=='rlut4co2'.OR.var%name=='rsutcs4co2' &
708	.OR. var%name=='rlutcs4co2'.OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2' &
709	.OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2'.OR.var%name=='rsd4co2'.OR. &
710	var%name=='rsdcs4co2'.OR.var%name=='rlu4co2'.OR.var%name=='rlucs4co2'.OR.&
711	var%name=='rld4co2'.OR.var%name=='rldcs4co2') THEN
712	IF ( var%flag(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE.
713	ENDIF
714	END SUBROUTINE histdef2d
715
716	SUBROUTINE histdef3d (iff,var)
717
718	USE ioipsl, ONLY: histdef
719	USE dimphy, ONLY: klev
720	USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
721	USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
722	clef_stations, phys_out_filenames, lev_files, &
723	nid_files, nhorim, swaerofree_diag, levmin, &
724	levmax, nvertm
725	USE print_control_mod, ONLY: prt_level,lunout
726	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
727	#ifdef CPP_XIOS
728	USE wxios, ONLY: wxios_add_field_to_file
729	#endif
730	USE print_control_mod, ONLY: prt_level,lunout
731	IMPLICIT NONE
732
733	INCLUDE "clesphys.h"
734
735	INTEGER :: iff
736	TYPE(ctrl_out) :: var
737
738	REAL zstophym
739	CHARACTER(LEN=20) :: typeecrit
740
741	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d for ', var%name
742
743	! ug On récupère le type écrit de la structure:
744	! Assez moche, à refaire si meilleure méthode...
745	IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
746	typeecrit = 'once'
747	ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
748	typeecrit = 't_min(X)'
749	ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
750	typeecrit = 't_max(X)'
751	ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
752	typeecrit = 'inst(X)'
753	ELSE
754	typeecrit = type_ecri_files(iff)
755	ENDIF
756
757	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
758	CALL conf_physoutputs(var%name,var%flag)
759
760	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
761	zstophym=zoutm(iff)
762	ELSE
763	zstophym=zdtime_moy
764	ENDIF
765
766	IF(.NOT.clef_stations(iff)) THEN
767
768	#ifdef CPP_XIOS
769	IF (.not. ok_all_xml) THEN
770	IF ( var%flag(iff)<=lev_files(iff) ) THEN
771	CALL wxios_add_field_to_file(var%name, 3, iff, phys_out_filenames(iff), &
772	var%description, var%unit, var%flag(iff), typeecrit)
773	IF (prt_level >= 10) THEN
774	WRITE(lunout,*) 'histdef3d: call wxios_add_field_to_file var%name iff: ', &
775	trim(var%name),iff
776	ENDIF
777	ENDIF
778	ENDIF
779	#endif
780	#ifndef CPP_IOIPSL_NO_OUTPUT
781
782	IF ( var%flag(iff)<=lev_files(iff) ) THEN
783	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
784	nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), &
785	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, typeecrit, &
786	zstophym, zoutm(iff))
787	ENDIF
788	ELSE
789	IF ( var%flag(iff)<=lev_files(iff)) THEN
790	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
791	npstn,1,nhorim(iff), klev, levmin(iff), &
792	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
793	typeecrit, zstophym,zoutm(iff))
794	ENDIF
795	#endif
796	ENDIF
797
798	! Set swaerofree_diag=true if at least one of the concerned variables are defined
799	IF (var%name=='rsucsaf' .OR. var%name=='rsdcsaf') THEN
800	IF ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
801	ENDIF
802
803	END SUBROUTINE histdef3d
804
805	SUBROUTINE conf_physoutputs(nam_var,flag_var)
806	!!! Lecture des noms et niveau de sortie des variables dans output.def
807	! en utilisant les routines getin de IOIPSL
808	USE ioipsl, ONLY: getin
809	USE phys_output_var_mod, ONLY: nfiles
810	USE print_control_mod, ONLY: prt_level,lunout
811	IMPLICIT NONE
812
813	CHARACTER(LEN=20) :: nam_var
814	INTEGER, DIMENSION(nfiles) :: flag_var
815
816	IF(prt_level>10) WRITE(lunout,*)'Avant getin: nam_var flag_var ',nam_var,flag_var(:)
817	CALL getin('flag_'//nam_var,flag_var)
818	CALL getin('name_'//nam_var,nam_var)
819	IF(prt_level>10) WRITE(lunout,*)'Apres getin: nam_var flag_var ',nam_var,flag_var(:)
820
821	END SUBROUTINE conf_physoutputs
822
823
824	SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
825
826	USE dimphy, ONLY: klon
827	USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
828	is_sequential, klon_mpi_begin, klon_mpi_end, &
829	jj_nb, klon_mpi, is_master
830	USE ioipsl, ONLY: histwrite
831	USE print_control_mod, ONLY: prt_level,lunout
832	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
833
834	IMPLICIT NONE
835
836	INTEGER,INTENT(IN) :: nid
837	LOGICAL,INTENT(IN) :: lpoint
838	CHARACTER(), INTENT(IN) :: name
839	INTEGER, INTENT(IN) :: itau
840	REAL,DIMENSION(:),INTENT(IN) :: field
841	REAL,DIMENSION(klon_mpi) :: buffer_omp
842	INTEGER, allocatable, DIMENSION(:) :: index2d
843	REAL :: Field2d(nbp_lon,jj_nb)
844
845	INTEGER :: ip
846	REAL,ALLOCATABLE,DIMENSION(:) :: fieldok
847
848	IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first DIMENSION not equal to klon',1)
849	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy_old for ', name
850
851	CALL Gather_omp(field,buffer_omp)
852	!$OMP MASTER
853	CALL grid1Dto2D_mpi(buffer_omp,Field2d)
854	IF (.NOT.lpoint) THEN
855	ALLOCATE(index2d(nbp_lon*jj_nb))
856	ALLOCATE(fieldok(nbp_lon*jj_nb))
857	IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
858	CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d)
859	IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
860	ELSE
861	ALLOCATE(fieldok(npstn))
862	ALLOCATE(index2d(npstn))
863
864	IF (is_sequential) THEN
865	! klon_mpi_begin=1
866	! klon_mpi_end=klon
867	DO ip=1, npstn
868	fieldok(ip)=buffer_omp(nptabij(ip))
869	ENDDO
870	ELSE
871	DO ip=1, npstn
872	! print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip)
873	IF(nptabij(ip).GE.klon_mpi_begin.AND. &
874	nptabij(ip).LE.klon_mpi_end) THEN
875	fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
876	ENDIF
877	ENDDO
878	ENDIF
879	IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
880	CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
881	IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
882	!
883	ENDIF
884	DEALLOCATE(index2d)
885	DEALLOCATE(fieldok)
886	!$OMP END MASTER
887
888
889	END SUBROUTINE histwrite2d_phy_old
890
891	SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field)
892
893	USE dimphy, ONLY: klon
894	USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
895	is_sequential, klon_mpi_begin, klon_mpi_end, &
896	jj_nb, klon_mpi, is_master
897	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
898	USE ioipsl, ONLY: histwrite
899	USE print_control_mod, ONLY: prt_level,lunout
900
901	IMPLICIT NONE
902
903	INTEGER,INTENT(IN) :: nid
904	LOGICAL,INTENT(IN) :: lpoint
905	CHARACTER(), INTENT(IN) :: name
906	INTEGER, INTENT(IN) :: itau
907	REAL,DIMENSION(:,:),INTENT(IN) :: field ! --> field(klon,:)
908	REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp
909	REAL :: Field3d(nbp_lon,jj_nb,size(field,2))
910	INTEGER :: ip, n, nlev
911	INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
912	REAL,allocatable, DIMENSION(:,:) :: fieldok
913
914	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy_old for ', name
915
916	IF (size(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
917	nlev=size(field,2)
918
919	CALL Gather_omp(field,buffer_omp)
920	!$OMP MASTER
921	CALL grid1Dto2D_mpi(buffer_omp,field3d)
922	IF (.NOT.lpoint) THEN
923	ALLOCATE(index3d(nbp_lonjj_nbnlev))
924	ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
925	IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
926	CALL histwrite(nid,name,itau,Field3d,nbp_lonjj_nbnlev,index3d)
927	IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
928	ELSE
929	nlev=size(field,2)
930	ALLOCATE(index3d(npstn*nlev))
931	ALLOCATE(fieldok(npstn,nlev))
932
933	IF (is_sequential) THEN
934	! klon_mpi_begin=1
935	! klon_mpi_end=klon
936	DO n=1, nlev
937	DO ip=1, npstn
938	fieldok(ip,n)=buffer_omp(nptabij(ip),n)
939	ENDDO
940	ENDDO
941	ELSE
942	DO n=1, nlev
943	DO ip=1, npstn
944	IF(nptabij(ip).GE.klon_mpi_begin.AND. &
945	nptabij(ip).LE.klon_mpi_end) THEN
946	fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
947	ENDIF
948	ENDDO
949	ENDDO
950	ENDIF
951	IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
952	CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
953	IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
954	ENDIF
955	DEALLOCATE(index3d)
956	DEALLOCATE(fieldok)
957	!$OMP END MASTER
958
959	END SUBROUTINE histwrite3d_phy_old
960
961
962	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
963	SUBROUTINE histwrite2d_phy(var,field, STD_iff)
964
965	USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp
966	USE dimphy, ONLY: klon, klev
967	USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
968	jj_nb, klon_mpi, klon_mpi_begin, &
969	klon_mpi_end, is_sequential, is_master
970	USE ioipsl, ONLY: histwrite
971	USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
972	nfiles, vars_defined, clef_stations, &
973	nid_files, swaerofree_diag, swaero_diag, dryaod_diag, ok_4xCO2atm
974	USE print_control_mod, ONLY: prt_level,lunout
975	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
976	#ifdef CPP_XIOS
977	USE xios, ONLY: xios_send_field
978	#endif
979	USE print_control_mod, ONLY: lunout, prt_level
980
981	IMPLICIT NONE
982	INCLUDE 'clesphys.h'
983
984	TYPE(ctrl_out), INTENT(IN) :: var
985	REAL, DIMENSION(:), INTENT(IN) :: field
986	INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
987
988	INTEGER :: iff, iff_beg, iff_end
989	LOGICAL, SAVE :: firstx
990	!$OMP THREADPRIVATE(firstx)
991
992	REAL,DIMENSION(klon_mpi) :: buffer_omp
993	INTEGER, allocatable, DIMENSION(:) :: index2d
994	REAL :: Field2d(nbp_lon,jj_nb)
995
996	INTEGER :: ip
997	REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
998
999	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name)
1000
1001	IF (prt_level >= 10) THEN
1002	WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
1003	ENDIF
1004
1005	! ug RUSTINE POUR LES STD LEVS.....
1006	IF (PRESENT(STD_iff)) THEN
1007	iff_beg = STD_iff
1008	iff_end = STD_iff
1009	ELSE
1010	iff_beg = 1
1011	iff_end = nfiles
1012	ENDIF
1013
1014	! On regarde si on est dans la phase de définition ou d'écriture:
1015	IF (.NOT.vars_defined) THEN
1016	!$OMP MASTER
1017	!Si phase de définition.... on définit
1018	IF (.not. ok_all_xml) THEN
1019	IF (prt_level >= 10) THEN
1020	write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", &
1021	trim(var%name)
1022	ENDIF
1023	DO iff=iff_beg, iff_end
1024	IF (clef_files(iff)) THEN
1025	CALL histdef2d(iff, var)
1026	ENDIF
1027	ENDDO
1028	ENDIF
1029	!$OMP END MASTER
1030	!--broadcasting the flags that have been changed in histdef2d on OMP masters
1031	CALL bcast_omp(swaero_diag)
1032	CALL bcast_omp(swaerofree_diag)
1033	CALL bcast_omp(dryaod_diag)
1034	CALL bcast_omp(ok_4xCO2atm)
1035
1036	ELSE
1037
1038	!Et sinon on.... écrit
1039	IF (SIZE(field)/=klon .AND. SIZE(field)/=klev) CALL abort_physic('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon/klev',1)
1040	IF (prt_level >= 10) THEn
1041	WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name)
1042	ENDIF
1043
1044
1045	IF (SIZE(field) == klon) then
1046	CALL Gather_omp(field,buffer_omp)
1047	ELSE
1048	buffer_omp(:)=0.
1049	ENDIF
1050	!$OMP MASTER
1051	IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,Field2d)
1052
1053	! La boucle sur les fichiers:
1054	firstx=.true.
1055
1056	IF (ok_all_xml) THEN
1057	#ifdef CPP_XIOS
1058	IF (prt_level >= 10) THEN
1059	write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)
1060	ENDIF
1061
1062	IF (grid_type==regular_lonlat) THEN
1063	IF (SIZE(field) == klon) then
1064	CALL xios_send_field(var%name, Field2d)
1065	ELSE
1066	CALL xios_send_field(var%name, field)
1067	ENDIF
1068	ELSE IF (grid_type==unstructured) THEN
1069	CALL xios_send_field(var%name, buffer_omp)
1070	ENDIF
1071	IF (prt_level >= 10) THEN
1072	write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',&
1073	trim(var%name)
1074	ENDIF
1075	#else
1076	CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
1077	#endif
1078	ELSE
1079	DO iff=iff_beg, iff_end
1080	IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
1081
1082	#ifdef CPP_XIOS
1083	IF (firstx) THEN
1084	IF (prt_level >= 10) THEN
1085	write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
1086	iff,trim(var%name)
1087	write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
1088	ENDIF
1089	IF (grid_type==regular_lonlat) THEN
1090	IF (SIZE(field) == klon) then
1091	CALL xios_send_field(var%name, Field2d)
1092	ELSE
1093	CALL xios_send_field(var%name, field)
1094	ENDIF
1095	ELSE IF (grid_type==unstructured) THEN
1096	CALL xios_send_field(var%name, buffer_omp)
1097	ENDIF
1098
1099	firstx=.false.
1100	ENDIF
1101	#endif
1102
1103	IF (.NOT.clef_stations(iff)) THEN
1104	ALLOCATE(index2d(nbp_lon*jj_nb))
1105	ALLOCATE(fieldok(nbp_lon*jj_nb))
1106	#ifndef CPP_IOIPSL_NO_OUTPUT
1107	CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,nbp_lon*jj_nb,index2d)
1108	#endif
1109	!#ifdef CPP_XIOS
1110	! IF (iff == iff_beg) THEN
1111	! IF (prt_level >= 10) THEN
1112	! write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call xios_send_field"
1113	! ENDIF
1114	! CALL xios_send_field(var%name, Field2d)
1115	! ENDIF
1116	!#endif
1117	ELSE
1118	ALLOCATE(fieldok(npstn))
1119	ALLOCATE(index2d(npstn))
1120
1121	IF (is_sequential) THEN
1122	DO ip=1, npstn
1123	fieldok(ip)=buffer_omp(nptabij(ip))
1124	ENDDO
1125	ELSE
1126	DO ip=1, npstn
1127	write(lunout,*)'histwrite2d_phy is_sequential npstn ip namenptabij',npstn,ip,var%name,nptabij(ip)
1128	IF(nptabij(ip).GE.klon_mpi_begin.AND. &
1129	nptabij(ip).LE.klon_mpi_end) THEN
1130	fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
1131	ENDIF
1132	ENDDO
1133	ENDIF ! of IF (is_sequential)
1134	#ifndef CPP_IOIPSL_NO_OUTPUT
1135	IF (prt_level >= 10) THEN
1136	write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D"
1137	ENDIF
1138	CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
1139	#endif
1140	ENDIF ! of IF(.NOT.clef_stations(iff))
1141
1142	DEALLOCATE(index2d)
1143	DEALLOCATE(fieldok)
1144	ENDIF !levfiles
1145	ENDDO ! of DO iff=iff_beg, iff_end
1146	ENDIF
1147	!$OMP END MASTER
1148	ENDIF ! vars_defined
1149
1150	IF (prt_level >= 10) WRITE(lunout,*)'End histwrite2d_phy ',trim(var%name)
1151
1152	END SUBROUTINE histwrite2d_phy
1153
1154
1155	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
1156	SUBROUTINE histwrite3d_phy(var, field, STD_iff)
1157
1158	USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp
1159	USE dimphy, ONLY: klon, klev
1160	USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
1161	jj_nb, klon_mpi, klon_mpi_begin, &
1162	klon_mpi_end, is_sequential, is_master
1163	USE ioipsl, ONLY: histwrite
1164	USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
1165	nfiles, vars_defined, clef_stations, &
1166	nid_files, swaerofree_diag
1167	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured
1168	#ifdef CPP_XIOS
1169	USE xios, ONLY: xios_send_field
1170	#endif
1171	USE print_control_mod, ONLY: prt_level,lunout
1172
1173	IMPLICIT NONE
1174	INCLUDE 'clesphys.h'
1175
1176	TYPE(ctrl_out), INTENT(IN) :: var
1177	REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
1178	INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
1179
1180	INTEGER :: iff, iff_beg, iff_end
1181	LOGICAL, SAVE :: firstx
1182	!$OMP THREADPRIVATE(firstx)
1183	REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
1184	REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
1185	INTEGER :: ip, n, nlev, nlevx
1186	INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
1187	REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
1188
1189	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy for ', trim(var%name)
1190
1191	IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d ',var%name
1192
1193	! ug RUSTINE POUR LES STD LEVS.....
1194	IF (PRESENT(STD_iff)) THEN
1195	iff_beg = STD_iff
1196	iff_end = STD_iff
1197	ELSE
1198	iff_beg = 1
1199	iff_end = nfiles
1200	ENDIF
1201
1202	! On regarde si on est dans la phase de définition ou d'écriture:
1203	IF (.NOT.vars_defined) THEN
1204	!Si phase de définition.... on définit
1205	!$OMP MASTER
1206	DO iff=iff_beg, iff_end
1207	IF (clef_files(iff)) THEN
1208	CALL histdef3d(iff, var)
1209	ENDIF
1210	ENDDO
1211	!$OMP END MASTER
1212	!--broadcasting the flag that have been changed in histdef3d on OMP masters
1213	CALL bcast_omp(swaerofree_diag)
1214	ELSE
1215	!Et sinon on.... écrit
1216
1217	IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev) CALL abort_physic('iophy::histwrite3d_xios','Field first DIMENSION not equal to klon/klev',1)
1218
1219	nlev=SIZE(field,2)
1220	IF (nlev.EQ.klev+1) THEN
1221	nlevx=klev
1222	ELSE
1223	nlevx=nlev
1224	ENDIF
1225
1226	IF (SIZE(field,1) == klon) then
1227	CALL Gather_omp(field,buffer_omp)
1228	ELSE
1229	buffer_omp(:,:)=0.
1230	ENDIF
1231	!$OMP MASTER
1232	IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,field3d)
1233
1234	! BOUCLE SUR LES FICHIERS
1235	firstx=.true.
1236
1237	IF (ok_all_xml) THEN
1238	#ifdef CPP_XIOS
1239	IF (prt_level >= 10) THEN
1240	write(lunout,*)'Dans iophy histwrite3D,var%name ',&
1241	trim(var%name)
1242	ENDIF
1243	IF (grid_type==regular_lonlat) THEN
1244	IF (SIZE(field,1) == klon) then
1245	CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
1246	ELSE
1247	CALL xios_send_field(var%name, field)
1248	ENDIF
1249	ELSE IF (grid_type==unstructured) THEN
1250	CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
1251	ENDIF
1252
1253	#else
1254	CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
1255	#endif
1256	ELSE
1257
1258	DO iff=iff_beg, iff_end
1259	IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
1260	#ifdef CPP_XIOS
1261	IF (firstx) THEN
1262	IF (prt_level >= 10) THEN
1263	write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
1264	iff,nlev,klev, firstx
1265	write(lunout,*)'histwrite3d_phy: call xios_send_field for ', &
1266	trim(var%name), ' with iim jjm nlevx = ', &
1267	nbp_lon,jj_nb,nlevx
1268	ENDIF
1269	IF (grid_type==regular_lonlat) THEN
1270	IF (SIZE(field,1) == klon) then
1271	CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
1272	ELSE
1273	CALL xios_send_field(var%name, field)
1274	ENDIF
1275	ELSE IF (grid_type==unstructured) THEN
1276	CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
1277	ENDIF
1278
1279	firstx=.false.
1280	ENDIF
1281	#endif
1282	IF (.NOT.clef_stations(iff)) THEN
1283	ALLOCATE(index3d(nbp_lonjj_nbnlev))
1284	ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
1285
1286	#ifndef CPP_IOIPSL_NO_OUTPUT
1287	CALL histwrite(nid_files(iff),var%name,itau_iophy,Field3d,nbp_lonjj_nbnlev,index3d)
1288	#endif
1289
1290	!#ifdef CPP_XIOS
1291	! IF (iff == 1) THEN
1292	! CALL xios_send_field(var%name, Field3d(:,:,1:klev))
1293	! ENDIF
1294	!#endif
1295	!
1296	ELSE
1297	nlev=size(field,2)
1298	ALLOCATE(index3d(npstn*nlev))
1299	ALLOCATE(fieldok(npstn,nlev))
1300
1301	IF (is_sequential) THEN
1302	DO n=1, nlev
1303	DO ip=1, npstn
1304	fieldok(ip,n)=buffer_omp(nptabij(ip),n)
1305	ENDDO
1306	ENDDO
1307	ELSE
1308	DO n=1, nlev
1309	DO ip=1, npstn
1310	IF(nptabij(ip).GE.klon_mpi_begin.AND. &
1311	nptabij(ip).LE.klon_mpi_end) THEN
1312	fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
1313	ENDIF
1314	ENDDO
1315	ENDDO
1316	ENDIF
1317	#ifndef CPP_IOIPSL_NO_OUTPUT
1318	CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d)
1319	#endif
1320	ENDIF
1321	DEALLOCATE(index3d)
1322	DEALLOCATE(fieldok)
1323	ENDIF
1324	ENDDO
1325	ENDIF
1326	!$OMP END MASTER
1327	ENDIF ! vars_defined
1328
1329	IF (prt_level >= 10) write(lunout,*)'End histrwrite3d ',var%name
1330
1331	END SUBROUTINE histwrite3d_phy
1332
1333
1334	! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV
1335	#ifdef CPP_XIOS
1336	SUBROUTINE histwrite2d_xios(field_name,field)
1337
1338	USE dimphy, ONLY: klon, klev
1339	USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
1340	is_sequential, klon_mpi_begin, klon_mpi_end, &
1341	jj_nb, klon_mpi, is_master
1342	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
1343	USE xios, ONLY: xios_send_field
1344	USE print_control_mod, ONLY: prt_level,lunout
1345
1346	IMPLICIT NONE
1347
1348	CHARACTER(LEN=*), INTENT(IN) :: field_name
1349	REAL, DIMENSION(:), INTENT(IN) :: field
1350
1351	REAL,DIMENSION(klon_mpi) :: buffer_omp
1352	INTEGER, allocatable, DIMENSION(:) :: index2d
1353	REAL :: Field2d(nbp_lon,jj_nb)
1354
1355	INTEGER :: ip
1356	REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
1357
1358	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_xios for ', field_name
1359
1360	IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
1361
1362	!Et sinon on.... écrit
1363	IF (SIZE(field)/=klon .AND. SIZE(field)/=klev) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev',1)
1364
1365	IF (SIZE(field) == klev) then
1366	!$OMP MASTER
1367	CALL xios_send_field(field_name,field)
1368	!$OMP END MASTER
1369	ELSE
1370	CALL Gather_omp(field,buffer_omp)
1371	!$OMP MASTER
1372
1373	IF (grid_type==unstructured) THEN
1374
1375	CALL xios_send_field(field_name, buffer_omp)
1376
1377	ELSE
1378
1379	CALL grid1Dto2D_mpi(buffer_omp,Field2d)
1380
1381	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1382	!ATTENTION, STATIONS PAS GEREES !
1383	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1384	!IF(.NOT.clef_stations(iff)) THEN
1385	IF (.TRUE.) THEN
1386
1387	CALL xios_send_field(field_name, Field2d)
1388
1389	ELSE
1390	ALLOCATE(fieldok(npstn))
1391	ALLOCATE(index2d(npstn))
1392
1393	IF (is_sequential) THEN
1394	DO ip=1, npstn
1395	fieldok(ip)=buffer_omp(nptabij(ip))
1396	ENDDO
1397	ELSE
1398	DO ip=1, npstn
1399	PRINT*,'histwrite2d_xios is_sequential npstn ip namenptabij',npstn,ip,field_name,nptabij(ip)
1400	IF(nptabij(ip).GE.klon_mpi_begin.AND. &
1401	nptabij(ip).LE.klon_mpi_end) THEN
1402	fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
1403	ENDIF
1404	ENDDO
1405	ENDIF
1406	DEALLOCATE(index2d)
1407	DEALLOCATE(fieldok)
1408
1409	ENDIF
1410	ENDIF
1411	!$OMP END MASTER
1412	ENDIF
1413
1414	IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',field_name
1415	END SUBROUTINE histwrite2d_xios
1416
1417
1418	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
1419	SUBROUTINE histwrite3d_xios(field_name, field)
1420
1421	USE dimphy, ONLY: klon, klev
1422	USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
1423	is_sequential, klon_mpi_begin, klon_mpi_end, &
1424	jj_nb, klon_mpi, is_master
1425	USE xios, ONLY: xios_send_field
1426	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
1427	USE print_control_mod, ONLY: prt_level,lunout
1428
1429	IMPLICIT NONE
1430
1431	CHARACTER(LEN=*), INTENT(IN) :: field_name
1432	REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
1433
1434	REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
1435	REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
1436	INTEGER :: ip, n, nlev
1437	INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
1438	REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
1439
1440	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_xios for ', field_name
1441
1442	IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',field_name
1443
1444	!Et on.... écrit
1445	IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev) CALL abort_physic('iophy::histwrite3d_xios','Field first DIMENSION not equal to klon/klev',1)
1446
1447	IF (SIZE(field,1) == klev) then
1448	!$OMP MASTER
1449	CALL xios_send_field(field_name,field)
1450	!$OMP END MASTER
1451	ELSE
1452	nlev=SIZE(field,2)
1453
1454
1455	CALL Gather_omp(field,buffer_omp)
1456	!$OMP MASTER
1457
1458	IF (grid_type==unstructured) THEN
1459
1460	CALL xios_send_field(field_name, buffer_omp(:,1:nlev))
1461
1462	ELSE
1463	CALL grid1Dto2D_mpi(buffer_omp,field3d)
1464
1465	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1466	!ATTENTION, STATIONS PAS GEREES !
1467	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1468	!IF (.NOT.clef_stations(iff)) THEN
1469	IF(.TRUE.)THEN
1470
1471	CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
1472
1473	ELSE
1474	nlev=size(field,2)
1475	ALLOCATE(index3d(npstn*nlev))
1476	ALLOCATE(fieldok(npstn,nlev))
1477
1478	IF (is_sequential) THEN
1479	DO n=1, nlev
1480	DO ip=1, npstn
1481	fieldok(ip,n)=buffer_omp(nptabij(ip),n)
1482	ENDDO
1483	ENDDO
1484	ELSE
1485	DO n=1, nlev
1486	DO ip=1, npstn
1487	IF(nptabij(ip).GE.klon_mpi_begin.AND. &
1488	nptabij(ip).LE.klon_mpi_end) THEN
1489	fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
1490	ENDIF
1491	ENDDO
1492	ENDDO
1493	ENDIF
1494	DEALLOCATE(index3d)
1495	DEALLOCATE(fieldok)
1496	ENDIF
1497	ENDIF
1498	!$OMP END MASTER
1499	ENDIF
1500
1501	IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',field_name
1502
1503	END SUBROUTINE histwrite3d_xios
1504
1505	#ifdef CPP_XIOS
1506	SUBROUTINE histwrite0d_xios(field_name, field)
1507	USE xios, ONLY: xios_send_field
1508	USE mod_phys_lmdz_para, ONLY: is_master
1509	USE print_control_mod, ONLY: prt_level,lunout
1510	IMPLICIT NONE
1511
1512	CHARACTER(LEN=*), INTENT(IN) :: field_name
1513	REAL, INTENT(IN) :: field ! --> scalar
1514
1515	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite0d_xios for ', field_name
1516
1517	!$OMP MASTER
1518	CALL xios_send_field(field_name, field)
1519	!$OMP END MASTER
1520
1521	END SUBROUTINE histwrite0d_xios
1522	#endif
1523
1524	#endif
1525	END MODULE iophy

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format