Context Navigation

iophy.F90 @ 5503

Last change on this file since 5503 was 5483, checked in by evignon, 6 days ago
ajout de omp_threadprivate manquants
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 `Id`
File size: 52.8 KB

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

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

Download in other formats:

Original Format