Context Navigation

iophy.F90 @ 5111

Last change on this file since 5111 was 5111, checked in by abarral, 4 months ago
Put abort_physic into a module Remove -g option from makelmdz_fcm, since that option is linked to a header file that isn't included anywhere. (lint) light lint on traversed files
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.7 KB

Line
1
2	! $Id: iophy.F90 5111 2024-07-24 10:17:33Z abarral $
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	INTERFACE histwrite_phy
19	MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios,histwrite0d_xios
20	END INTERFACE
21
22	INTERFACE histbeg_phy_all
23	MODULE PROCEDURE histbeg_phy,histbeg_phyxios,histbeg_phy_points
24	END INTERFACE
25
26
27	CONTAINS
28
29	! ug Routine pour définir itau_iophy depuis phys_output_write_mod:
30	SUBROUTINE set_itau_iophy(ito)
31	IMPLICIT NONE
32	INTEGER, INTENT(IN) :: ito
33	itau_iophy = ito
34	END SUBROUTINE
35
36	SUBROUTINE init_iophy_new(rlat,rlon)
37
38	USE dimphy, ONLY: klon
39	USE lmdz_phys_para, ONLY: gather, bcast, &
40	jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
41	mpi_size, mpi_rank, klon_mpi, &
42	is_sequential, is_south_pole_dyn
43	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
44	USE print_control_mod, ONLY: prt_level,lunout
45	USE ioipsl, ONLY: flio_dom_set
46	use wxios, 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 lmdz_phys_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 lmdz_grid_phy, 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 dimphy
209	USE lmdz_phys_para, ONLY: is_sequential, is_using_mpi, is_mpi_root, &
210	jj_begin, jj_end, jj_nb
211	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
212	USE ioipsl, ONLY: histbeg
213	USE wxios, ONLY: wxios_add_file, using_xios
214	IMPLICIT NONE
215	INCLUDE 'clesphys.h'
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 lmdz_phys_para, ONLY: jj_begin, jj_end, jj_nb, is_sequential
251	USE lmdz_grid_phy, 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 lmdz_phys_para, ONLY: gather, bcast, &
283	is_sequential, klon_mpi_begin, klon_mpi_end, &
284	mpi_rank
285	USE lmdz_grid_phy, 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)<=0..AND.plon_bounds(i,1)>=0.) THEN
329	IF (rlon_glo(tabij(i))>=0.) THEN
330	plon_bounds(i,2)=-1*plon_bounds(i,2)
331	ENDIF
332	ENDIF
333	IF (plon_bounds(i,2)>=0..AND.plon_bounds(i,1)<=0.) THEN
334	IF (rlon_glo(tabij(i))<=0.) THEN
335	plon_bounds(i,2)=-1*plon_bounds(i,2)
336	ENDIF
337	ENDIF
338
339	IF ( tabij(i)<=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)>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)==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)==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)==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)==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)>=tabprocbeg.AND.tabij(ip)<=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)>=tabprocbeg.AND.tabij(ip)<=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 lmdz_phys_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 lmdz_grid_phy, 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
465	IMPLICIT NONE
466
467	INCLUDE "clesphys.h"
468
469	INTEGER :: iff
470	INTEGER :: naero
471	LOGICAL :: lpoint
472	INTEGER, DIMENSION(nfiles) :: flag_var
473	CHARACTER(LEN=20) :: nomvar
474	CHARACTER(LEN=*) :: titrevar
475	CHARACTER(LEN=*) :: unitvar
476
477	REAL zstophym
478
479	IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
480	zstophym=zoutm(iff)
481	ELSE
482	zstophym=zdtime_moy
483	ENDIF
484	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d_old for ', nomvar
485	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
486	CALL conf_physoutputs(nomvar,flag_var)
487
488	IF(.NOT.lpoint) THEN
489	IF ( flag_var(iff)<=lev_files(iff) ) THEN
490	CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
491	nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
492	type_ecri(iff), zstophym,zoutm(iff))
493	ENDIF
494	ELSE
495	IF ( flag_var(iff)<=lev_files(iff) ) THEN
496	CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
497	npstn,1,nhorim(iff), 1,1,1, -99, 32, &
498	type_ecri(iff), zstophym,zoutm(iff))
499	ENDIF
500	ENDIF
501
502	! Set swaero_diag=true if at least one of the concerned variables are defined
503	IF (nomvar=='topswad' .OR. nomvar=='topswad0' .OR. nomvar=='solswad' .OR. nomvar=='solswad0' .OR. &
504	nomvar=='toplwad' .OR. nomvar=='toplwad0' .OR. nomvar=='sollwad' .OR. nomvar=='sollwad0' .OR. &
505	nomvar=='topswai' .OR. nomvar=='solswai' ) THEN
506	IF ( flag_var(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
507	ENDIF
508
509	! Set dryaod_diag=true if at least one of the concerned variables are defined
510	IF (nomvar=='dryod550aer') THEN
511	IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
512	ENDIF
513	DO naero = 1, naero_tot-1
514	IF (nomvar=='dryod550_'//name_aero_tau(naero)) THEN
515	IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
516	ENDIF
517	ENDDO
518
519	! Set ok_4xCO2atm=true if at least one of the concerned variables are
520	! defined
521	IF (nomvar=='rsut4co2'.OR.nomvar=='rlut4co2'.OR.nomvar=='rsutcs4co2' &
522	.OR. nomvar=='rlutcs4co2'.OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2' &
523	.OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2'.OR.nomvar=='rsd4co2'.OR. &
524	nomvar=='rsdcs4co2'.OR.nomvar=='rlu4co2'.OR.nomvar=='rlucs4co2'.OR.&
525	nomvar=='rld4co2'.OR.nomvar=='rldcs4co2') THEN
526	IF ( flag_var(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE.
527	ENDIF
528	END SUBROUTINE histdef2d_old
529
530	SUBROUTINE histdef3d_old(iff,lpoint,flag_var,nomvar,titrevar,unitvar)
531
532	USE ioipsl, ONLY: histdef
533	USE dimphy, ONLY: klev
534	USE lmdz_phys_para, ONLY: jj_nb, is_master
535	USE phys_output_var_mod, ONLY: type_ecri, zoutm, lev_files, nid_files, &
536	nhorim, zdtime_moy, levmin, levmax, &
537	nvertm, nfiles
538	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
539	USE print_control_mod, ONLY: prt_level,lunout
540	IMPLICIT NONE
541
542	INCLUDE "clesphys.h"
543
544	INTEGER :: iff
545	LOGICAL :: lpoint
546	INTEGER, DIMENSION(nfiles) :: flag_var
547	CHARACTER(LEN=20) :: nomvar
548	CHARACTER(LEN=*) :: titrevar
549	CHARACTER(LEN=*) :: unitvar
550
551	REAL zstophym
552
553	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
554	CALL conf_physoutputs(nomvar,flag_var)
555
556	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d_old for ', nomvar
557
558	IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
559	zstophym=zoutm(iff)
560	ELSE
561	zstophym=zdtime_moy
562	ENDIF
563
564	IF(.NOT.lpoint) THEN
565	IF ( flag_var(iff)<=lev_files(iff) ) THEN
566	CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
567	nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), &
568	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, type_ecri(iff), &
569	zstophym, zoutm(iff))
570	ENDIF
571	ELSE
572	IF ( flag_var(iff)<=lev_files(iff) ) THEN
573	CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
574	npstn,1,nhorim(iff), klev, levmin(iff), &
575	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
576	type_ecri(iff), zstophym,zoutm(iff))
577	ENDIF
578	ENDIF
579	END SUBROUTINE histdef3d_old
580
581	SUBROUTINE histdef2d(iff,var)
582
583	USE ioipsl, ONLY: histdef
584	USE lmdz_phys_para, ONLY: jj_nb, is_master
585	USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
586	clef_stations, phys_out_filenames, lev_files, &
587	nid_files, nhorim, swaerofree_diag, swaero_diag, dryaod_diag,&
588	ok_4xCO2atm
589	USE print_control_mod, ONLY: prt_level,lunout
590	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
591	USE aero_mod, ONLY: naero_tot, name_aero_tau
592	USE wxios, ONLY: wxios_add_field_to_file, using_xios
593	USE print_control_mod, ONLY: prt_level,lunout
594	IMPLICIT NONE
595
596	INCLUDE "clesphys.h"
597
598	INTEGER :: iff
599	INTEGER :: naero
600	TYPE(ctrl_out) :: var
601
602	REAL zstophym
603	CHARACTER(LEN=20) :: typeecrit
604
605	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d for ', var%name
606
607	! ug On récupère le type écrit de la structure:
608	! Assez moche, à refaire si meilleure méthode...
609	IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
610	typeecrit = 'once'
611	ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
612	typeecrit = 't_min(X)'
613	ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
614	typeecrit = 't_max(X)'
615	ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
616	typeecrit = 'inst(X)'
617	ELSE
618	typeecrit = type_ecri_files(iff)
619	ENDIF
620
621	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
622	zstophym=zoutm(iff)
623	ELSE
624	zstophym=zdtime_moy
625	ENDIF
626
627	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
628	CALL conf_physoutputs(var%name, var%flag)
629
630	IF(.NOT.clef_stations(iff)) THEN
631
632	IF (using_xios) THEN
633	IF (.not. ok_all_xml) THEN
634	IF ( var%flag(iff)<=lev_files(iff) ) THEN
635	CALL wxios_add_field_to_file(var%name, 2, iff, phys_out_filenames(iff), &
636	var%description, var%unit, var%flag(iff), typeecrit)
637	IF (prt_level >= 10) THEN
638	WRITE(lunout,*) 'histdef2d: CALL wxios_add_field_to_file var%name iff: ', &
639	trim(var%name),iff
640	ENDIF
641	ENDIF
642	ENDIF
643	ENDIF
644	#ifndef CPP_IOIPSL_NO_OUTPUT
645
646	IF ( var%flag(iff)<=lev_files(iff) ) THEN
647	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
648	nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
649	typeecrit, zstophym,zoutm(iff))
650	ENDIF
651	ELSE
652	IF ( var%flag(iff)<=lev_files(iff)) THEN
653	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
654	npstn,1,nhorim(iff), 1,1,1, -99, 32, &
655	typeecrit, zstophym,zoutm(iff))
656	ENDIF
657	#endif
658	ENDIF
659
660	! Set swaero_diag=true if at least one of the concerned variables are defined
661	!--OB 30/05/2016 use wider set of variables
662	IF ( var%name=='topswad' .OR. var%name=='topswad0' .OR. var%name=='solswad' .OR. var%name=='solswad0' .OR. &
663	var%name=='topswai' .OR. var%name=='solswai' .OR. ( iflag_rrtm==1 .AND. ( &
664	var%name=='toplwad' .OR. var%name=='toplwad0' .OR. var%name=='sollwad' .OR. var%name=='sollwad0' .OR. &
665	var%name=='toplwai' .OR. var%name=='sollwai' ) ) ) THEN
666	IF ( var%flag(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
667	ENDIF
668
669	! Set swaerofree_diag=true if at least one of the concerned variables are defined
670	IF (var%name=='SWupTOAcleanclr' .OR. var%name=='SWupSFCcleanclr' .OR. var%name=='SWdnSFCcleanclr' .OR. &
671	var%name=='LWupTOAcleanclr' .OR. var%name=='LWdnSFCcleanclr' ) THEN
672	IF ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
673	ENDIF
674
675	! set dryaod_dry=true if at least one of the concerned variables are defined
676	IF (var%name=='dryod550aer') THEN
677	IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
678	ENDIF
679
680	DO naero = 1, naero_tot-1
681	IF (var%name=='dryod550_'//name_aero_tau(naero)) THEN
682	IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
683	ENDIF
684	ENDDO
685	! Set ok_4xCO2atm=true if at least one of the concerned variables are
686	! defined
687	IF (var%name=='rsut4co2'.OR.var%name=='rlut4co2'.OR.var%name=='rsutcs4co2' &
688	.OR. var%name=='rlutcs4co2'.OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2' &
689	.OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2'.OR.var%name=='rsd4co2'.OR. &
690	var%name=='rsdcs4co2'.OR.var%name=='rlu4co2'.OR.var%name=='rlucs4co2'.OR.&
691	var%name=='rld4co2'.OR.var%name=='rldcs4co2') THEN
692	IF ( var%flag(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE.
693	ENDIF
694	END SUBROUTINE histdef2d
695
696	SUBROUTINE histdef3d(iff,var)
697
698	USE ioipsl, ONLY: histdef
699	USE dimphy, ONLY: klev
700	USE lmdz_phys_para, ONLY: jj_nb, is_master
701	USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
702	clef_stations, phys_out_filenames, lev_files, &
703	nid_files, nhorim, swaerofree_diag, levmin, &
704	levmax, nvertm
705	USE print_control_mod, ONLY: prt_level,lunout
706	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
707	USE wxios, ONLY: wxios_add_field_to_file, using_xios
708	USE print_control_mod, ONLY: prt_level,lunout
709	IMPLICIT NONE
710
711	INCLUDE "clesphys.h"
712
713	INTEGER :: iff
714	TYPE(ctrl_out) :: var
715
716	REAL zstophym
717	CHARACTER(LEN=20) :: typeecrit
718
719	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d for ', var%name
720
721	! ug On récupère le type écrit de la structure:
722	! Assez moche, à refaire si meilleure méthode...
723	IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
724	typeecrit = 'once'
725	ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
726	typeecrit = 't_min(X)'
727	ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
728	typeecrit = 't_max(X)'
729	ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
730	typeecrit = 'inst(X)'
731	ELSE
732	typeecrit = type_ecri_files(iff)
733	ENDIF
734
735	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
736	CALL conf_physoutputs(var%name,var%flag)
737
738	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
739	zstophym=zoutm(iff)
740	ELSE
741	zstophym=zdtime_moy
742	ENDIF
743
744	IF(.NOT.clef_stations(iff)) THEN
745
746	IF (using_xios) THEN
747
748	IF (.not. ok_all_xml) THEN
749	IF ( var%flag(iff)<=lev_files(iff) ) THEN
750	CALL wxios_add_field_to_file(var%name, 3, iff, phys_out_filenames(iff), &
751	var%description, var%unit, var%flag(iff), typeecrit)
752	IF (prt_level >= 10) THEN
753	WRITE(lunout,*) 'histdef3d: CALL wxios_add_field_to_file var%name iff: ', &
754	trim(var%name),iff
755	ENDIF
756	ENDIF
757	ENDIF
758	ENDIF
759	#ifndef CPP_IOIPSL_NO_OUTPUT
760
761	IF ( var%flag(iff)<=lev_files(iff) ) THEN
762	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
763	nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), &
764	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, typeecrit, &
765	zstophym, zoutm(iff))
766	ENDIF
767	ELSE
768	IF ( var%flag(iff)<=lev_files(iff)) THEN
769	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
770	npstn,1,nhorim(iff), klev, levmin(iff), &
771	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
772	typeecrit, zstophym,zoutm(iff))
773	ENDIF
774	#endif
775	ENDIF
776
777	! Set swaerofree_diag=true if at least one of the concerned variables are defined
778	IF (var%name=='rsucsaf' .OR. var%name=='rsdcsaf') THEN
779	IF ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
780	ENDIF
781
782	END SUBROUTINE histdef3d
783
784	SUBROUTINE conf_physoutputs(nam_var,flag_var)
785	!!! Lecture des noms et niveau de sortie des variables dans output.def
786	! en utilisant les routines getin de IOIPSL
787	USE ioipsl, ONLY: getin
788	USE phys_output_var_mod, ONLY: nfiles
789	USE print_control_mod, ONLY: prt_level,lunout
790	IMPLICIT NONE
791
792	CHARACTER(LEN=*), INTENT(INOUT) :: nam_var
793	INTEGER, INTENT(INOUT) :: flag_var(nfiles)
794
795	IF(prt_level>10) WRITE(lunout,*)'Avant getin: nam_var flag_var ',nam_var,flag_var(:)
796	CALL getin('flag_'//nam_var,flag_var)
797	CALL getin('name_'//nam_var,nam_var)
798	IF(prt_level>10) WRITE(lunout,*)'Apres getin: nam_var flag_var ',nam_var,flag_var(:)
799
800	END SUBROUTINE conf_physoutputs
801
802
803	SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
804
805	USE dimphy, ONLY: klon
806	USE lmdz_phys_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
807	is_sequential, klon_mpi_begin, klon_mpi_end, &
808	jj_nb, klon_mpi, is_master
809	USE ioipsl, ONLY: histwrite
810	USE print_control_mod, ONLY: prt_level,lunout
811	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
812	USE lmdz_abort_physic, ONLY: abort_physic
813
814	IMPLICIT NONE
815
816	INTEGER,INTENT(IN) :: nid
817	LOGICAL,INTENT(IN) :: lpoint
818	CHARACTER(), INTENT(IN) :: name
819	INTEGER, INTENT(IN) :: itau
820	REAL,DIMENSION(:),INTENT(IN) :: field
821	REAL,DIMENSION(klon_mpi) :: buffer_omp
822	INTEGER, allocatable, DIMENSION(:) :: index2d
823	REAL :: Field2d(nbp_lon,jj_nb)
824
825	INTEGER :: ip
826	REAL,ALLOCATABLE,DIMENSION(:) :: fieldok
827
828	IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first DIMENSION not equal to klon',1)
829	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy_old for ', name
830
831	CALL Gather_omp(field,buffer_omp)
832	!$OMP MASTER
833	CALL grid1Dto2D_mpi(buffer_omp,Field2d)
834	IF (.NOT.lpoint) THEN
835	ALLOCATE(index2d(nbp_lon*jj_nb))
836	ALLOCATE(fieldok(nbp_lon*jj_nb))
837	IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
838	CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d)
839	IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
840	ELSE
841	ALLOCATE(fieldok(npstn))
842	ALLOCATE(index2d(npstn))
843
844	IF (is_sequential) THEN
845	! klon_mpi_begin=1
846	! klon_mpi_end=klon
847	DO ip=1, npstn
848	fieldok(ip)=buffer_omp(nptabij(ip))
849	ENDDO
850	ELSE
851	DO ip=1, npstn
852	! PRINT*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip)
853	IF(nptabij(ip)>=klon_mpi_begin.AND. &
854	nptabij(ip)<=klon_mpi_end) THEN
855	fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
856	ENDIF
857	ENDDO
858	ENDIF
859	IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
860	CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
861	IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
862
863	ENDIF
864	DEALLOCATE(index2d)
865	DEALLOCATE(fieldok)
866	!$OMP END MASTER
867
868
869	END SUBROUTINE histwrite2d_phy_old
870
871	SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field)
872
873	USE dimphy, ONLY: klon
874	USE lmdz_phys_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
875	is_sequential, klon_mpi_begin, klon_mpi_end, &
876	jj_nb, klon_mpi, is_master
877	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
878	USE ioipsl, ONLY: histwrite
879	USE print_control_mod, ONLY: prt_level,lunout
880
881	IMPLICIT NONE
882
883	INTEGER,INTENT(IN) :: nid
884	LOGICAL,INTENT(IN) :: lpoint
885	CHARACTER(), INTENT(IN) :: name
886	INTEGER, INTENT(IN) :: itau
887	REAL,DIMENSION(:,:),INTENT(IN) :: field ! --> field(klon,:)
888	REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp
889	REAL :: Field3d(nbp_lon,jj_nb,size(field,2))
890	INTEGER :: ip, n, nlev
891	INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
892	REAL,allocatable, DIMENSION(:,:) :: fieldok
893
894	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy_old for ', name
895
896	IF (size(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
897	nlev=size(field,2)
898
899	CALL Gather_omp(field,buffer_omp)
900	!$OMP MASTER
901	CALL grid1Dto2D_mpi(buffer_omp,field3d)
902	IF (.NOT.lpoint) THEN
903	ALLOCATE(index3d(nbp_lonjj_nbnlev))
904	ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
905	IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
906	CALL histwrite(nid,name,itau,Field3d,nbp_lonjj_nbnlev,index3d)
907	IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
908	ELSE
909	nlev=size(field,2)
910	ALLOCATE(index3d(npstn*nlev))
911	ALLOCATE(fieldok(npstn,nlev))
912
913	IF (is_sequential) THEN
914	! klon_mpi_begin=1
915	! klon_mpi_end=klon
916	DO n=1, nlev
917	DO ip=1, npstn
918	fieldok(ip,n)=buffer_omp(nptabij(ip),n)
919	ENDDO
920	ENDDO
921	ELSE
922	DO n=1, nlev
923	DO ip=1, npstn
924	IF(nptabij(ip)>=klon_mpi_begin.AND. &
925	nptabij(ip)<=klon_mpi_end) THEN
926	fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
927	ENDIF
928	ENDDO
929	ENDDO
930	ENDIF
931	IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
932	CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
933	IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
934	ENDIF
935	DEALLOCATE(index3d)
936	DEALLOCATE(fieldok)
937	!$OMP END MASTER
938
939	END SUBROUTINE histwrite3d_phy_old
940
941
942	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
943	SUBROUTINE histwrite2d_phy(var,field, STD_iff)
944
945	USE lmdz_phys_omp_transfert, ONLY: bcast_omp
946	USE dimphy, ONLY: klon, klev
947	USE lmdz_phys_para, ONLY: gather_omp, grid1dto2d_mpi, &
948	jj_nb, klon_mpi, klon_mpi_begin, &
949	klon_mpi_end, is_sequential, is_master
950	USE ioipsl, ONLY: histwrite
951	USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
952	nfiles, vars_defined, clef_stations, &
953	nid_files, swaerofree_diag, swaero_diag, dryaod_diag, ok_4xCO2atm
954	USE print_control_mod, ONLY: prt_level,lunout
955	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
956	USE lmdz_xios, ONLY: xios_send_field, xios_field_is_active, using_xios
957	USE print_control_mod, ONLY: lunout, prt_level
958	USE lmdz_abort_physic, ONLY: abort_physic
959
960	IMPLICIT NONE
961	INCLUDE 'clesphys.h'
962
963	TYPE(ctrl_out), INTENT(IN) :: var
964	REAL, DIMENSION(:), INTENT(IN) :: field
965	INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
966
967	INTEGER :: iff, iff_beg, iff_end
968	LOGICAL, SAVE :: firstx
969	!$OMP THREADPRIVATE(firstx)
970
971	REAL,DIMENSION(klon_mpi) :: buffer_omp
972	INTEGER, allocatable, DIMENSION(:) :: index2d
973	REAL :: Field2d(nbp_lon,jj_nb)
974
975	INTEGER :: ip
976	REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
977	logical, save :: is_active = .TRUE.
978
979	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name)
980
981	IF (prt_level >= 10) THEN
982	WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
983	ENDIF
984
985	! ug RUSTINE POUR LES STD LEVS.....
986	IF (PRESENT(STD_iff)) THEN
987	iff_beg = STD_iff
988	iff_end = STD_iff
989	ELSE
990	iff_beg = 1
991	iff_end = nfiles
992	ENDIF
993
994	! On regarde si on est dans la phase de définition ou d'écriture:
995	IF (.NOT.vars_defined) THEN
996	!$OMP MASTER
997	!Si phase de définition.... on définit
998	IF (.not. ok_all_xml) THEN
999	IF (prt_level >= 10) THEN
1000	write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", &
1001	trim(var%name)
1002	ENDIF
1003	DO iff=iff_beg, iff_end
1004	IF (clef_files(iff)) THEN
1005	CALL histdef2d(iff, var)
1006	ENDIF
1007	ENDDO
1008	ENDIF
1009	!$OMP END MASTER
1010	!--broadcasting the flags that have been changed in histdef2d on OMP masters
1011	CALL bcast_omp(swaero_diag)
1012	CALL bcast_omp(swaerofree_diag)
1013	CALL bcast_omp(dryaod_diag)
1014	CALL bcast_omp(ok_4xCO2atm)
1015
1016	ELSE
1017	IF (using_xios) THEN
1018	IF (ok_all_xml) THEN
1019	!$omp barrier
1020	!$omp master
1021	is_active = xios_field_is_active(var%name, at_current_timestep_arg=.FALSE.)
1022	!$omp end master
1023	!$omp barrier
1024	IF(.not. is_active) RETURN
1025	ENDIF
1026	ENDIF
1027
1028	!Et sinon on.... écrit
1029	IF (SIZE(field)/=klon .AND. SIZE(field)/=klev .AND. SIZE(field)/=klev+1) &
1030	CALL abort_physic('iophy::histwrite2d_phy',&
1031	'Field first DIMENSION not equal to klon/klev',1)
1032	IF (prt_level >= 10) THEn
1033	WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name)
1034	ENDIF
1035
1036
1037	IF (SIZE(field) == klon) then
1038	CALL Gather_omp(field,buffer_omp)
1039	ELSE
1040	buffer_omp(:)=0.
1041	ENDIF
1042	!$OMP MASTER
1043	IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,Field2d)
1044
1045	! La boucle sur les fichiers:
1046	firstx=.TRUE.
1047
1048	IF (ok_all_xml) THEN
1049	IF (using_xios) THEN
1050	IF (prt_level >= 10) THEN
1051	write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)
1052	ENDIF
1053
1054	IF (grid_type==regular_lonlat) THEN
1055	IF (SIZE(field) == klon) then
1056	CALL xios_send_field(var%name, Field2d)
1057	ELSE
1058	CALL xios_send_field(var%name, field)
1059	ENDIF
1060	ELSE IF (grid_type==unstructured) THEN
1061	IF (SIZE(field) == klon) then
1062	CALL xios_send_field(var%name, buffer_omp)
1063	ELSE
1064	CALL xios_send_field(var%name, field)
1065	ENDIF
1066
1067	ENDIF
1068	IF (prt_level >= 10) THEN
1069	write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',&
1070	trim(var%name)
1071	ENDIF
1072	ELSE
1073	CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
1074	ENDIF
1075	ELSE
1076	DO iff=iff_beg, iff_end
1077	IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
1078
1079	IF (using_xios) THEN
1080	IF (firstx) THEN
1081	IF (prt_level >= 10) THEN
1082	write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
1083	iff,trim(var%name)
1084	write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, CALL xios_send_field"
1085	ENDIF
1086	IF (grid_type==regular_lonlat) THEN
1087	IF (SIZE(field) == klon) then
1088	CALL xios_send_field(var%name, Field2d)
1089	ELSE
1090	CALL xios_send_field(var%name, field)
1091	ENDIF
1092	ELSE IF (grid_type==unstructured) THEN
1093	IF (SIZE(field) == klon) then
1094	CALL xios_send_field(var%name, buffer_omp)
1095	ELSE
1096	CALL xios_send_field(var%name, field)
1097	ENDIF
1098	ENDIF
1099
1100	firstx=.FALSE.
1101	ENDIF
1102	ENDIF
1103
1104	IF (.NOT.clef_stations(iff)) THEN
1105	ALLOCATE(index2d(nbp_lon*jj_nb))
1106	ALLOCATE(fieldok(nbp_lon*jj_nb))
1107	#ifndef CPP_IOIPSL_NO_OUTPUT
1108	CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,nbp_lon*jj_nb,index2d)
1109	#endif
1110	! IF (using_xios) THEN
1111	! IF (iff == iff_beg) THEN
1112	! IF (prt_level >= 10) THEN
1113	! write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, CALL xios_send_field"
1114	! ENDIF
1115	! CALL xios_send_field(var%name, Field2d)
1116	! ENDIF
1117	! ENDIF
1118	ELSE
1119	ALLOCATE(fieldok(npstn))
1120	ALLOCATE(index2d(npstn))
1121
1122	IF (is_sequential) THEN
1123	DO ip=1, npstn
1124	fieldok(ip)=buffer_omp(nptabij(ip))
1125	ENDDO
1126	ELSE
1127	DO ip=1, npstn
1128	write(lunout,*)'histwrite2d_phy is_sequential npstn ip namenptabij',npstn,ip,var%name,nptabij(ip)
1129	IF(nptabij(ip)>=klon_mpi_begin.AND. &
1130	nptabij(ip)<=klon_mpi_end) THEN
1131	fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
1132	ENDIF
1133	ENDDO
1134	ENDIF ! of IF (is_sequential)
1135	#ifndef CPP_IOIPSL_NO_OUTPUT
1136	IF (prt_level >= 10) THEN
1137	write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, CALL wxios_write_2D"
1138	ENDIF
1139	CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
1140	#endif
1141	ENDIF ! of IF(.NOT.clef_stations(iff))
1142
1143	DEALLOCATE(index2d)
1144	DEALLOCATE(fieldok)
1145	ENDIF !levfiles
1146	ENDDO ! of DO iff=iff_beg, iff_end
1147	ENDIF
1148	!$OMP END MASTER
1149	ENDIF ! vars_defined
1150
1151	IF (prt_level >= 10) WRITE(lunout,*)'End histwrite2d_phy ',trim(var%name)
1152
1153	END SUBROUTINE histwrite2d_phy
1154
1155
1156	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
1157	SUBROUTINE histwrite3d_phy(var, field, STD_iff)
1158
1159	USE lmdz_phys_omp_transfert, ONLY: bcast_omp
1160	USE dimphy, ONLY: klon, klev
1161	USE lmdz_phys_para, ONLY: gather_omp, grid1dto2d_mpi, &
1162	jj_nb, klon_mpi, klon_mpi_begin, &
1163	klon_mpi_end, is_sequential, is_master
1164	USE ioipsl, ONLY: histwrite
1165	USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
1166	nfiles, vars_defined, clef_stations, &
1167	nid_files, swaerofree_diag
1168	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured
1169	USE lmdz_xios, ONLY: xios_send_field, xios_field_is_active, using_xios
1170	USE print_control_mod, ONLY: prt_level,lunout
1171	USE lmdz_abort_physic, ONLY: abort_physic
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	logical, save :: is_active = .TRUE.
1189
1190	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy for ', trim(var%name)
1191
1192	IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d ',var%name
1193
1194	! ug RUSTINE POUR LES STD LEVS.....
1195	IF (PRESENT(STD_iff)) THEN
1196	iff_beg = STD_iff
1197	iff_end = STD_iff
1198	ELSE
1199	iff_beg = 1
1200	iff_end = nfiles
1201	ENDIF
1202
1203	! On regarde si on est dans la phase de définition ou d'écriture:
1204	IF (.NOT.vars_defined) THEN
1205	!Si phase de définition.... on définit
1206	!$OMP MASTER
1207	DO iff=iff_beg, iff_end
1208	IF (clef_files(iff)) THEN
1209	CALL histdef3d(iff, var)
1210	ENDIF
1211	ENDDO
1212	!$OMP END MASTER
1213	!--broadcasting the flag that have been changed in histdef3d on OMP masters
1214	CALL bcast_omp(swaerofree_diag)
1215	ELSE
1216	IF (using_xios) THEN
1217	IF (ok_all_xml) THEN
1218	!$omp barrier
1219	!$omp master
1220	is_active = xios_field_is_active(var%name, at_current_timestep_arg=.FALSE.)
1221	!$omp end master
1222	!$omp barrier
1223	IF(.not. is_active) RETURN
1224	ENDIF
1225	ENDIF
1226
1227	!Et sinon on.... écrit
1228	IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev &
1229	.AND. SIZE(field,1)/=klev+1) &
1230	CALL abort_physic('iophy::histwrite3d_phy', &
1231	'Field first DIMENSION not equal to klon/klev',1)
1232
1233	nlev=SIZE(field,2)
1234	nlevx=nlev
1235	! IF (nlev.EQ.klev+1) THEN
1236	! nlevx=klev
1237	! ELSE
1238	! nlevx=nlev
1239	! ENDIF
1240
1241	IF (SIZE(field,1) == klon) then
1242	CALL Gather_omp(field,buffer_omp)
1243	ELSE
1244	buffer_omp(:,:)=0.
1245	ENDIF
1246	!$OMP MASTER
1247	IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,field3d)
1248
1249	! BOUCLE SUR LES FICHIERS
1250	firstx=.TRUE.
1251
1252	IF (ok_all_xml) THEN
1253	IF (using_xios) THEN
1254	IF (prt_level >= 10) THEN
1255	write(lunout,*)'Dans iophy histwrite3D,var%name ',&
1256	trim(var%name)
1257	ENDIF
1258	IF (grid_type==regular_lonlat) THEN
1259	IF (SIZE(field,1) == klon) then
1260	CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
1261	ELSE
1262	CALL xios_send_field(var%name, field)
1263	ENDIF
1264	ELSE IF (grid_type==unstructured) THEN
1265	IF (SIZE(field,1) == klon) then
1266	CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
1267	ELSE
1268	CALL xios_send_field(var%name, field)
1269	ENDIF
1270	ENDIF
1271
1272	ELSE
1273	CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
1274	ENDIF
1275	ELSE
1276
1277	DO iff=iff_beg, iff_end
1278	IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
1279	IF (using_xios) THEN
1280	IF (firstx) THEN
1281	IF (prt_level >= 10) THEN
1282	write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
1283	iff,nlev,klev, firstx
1284	write(lunout,*)'histwrite3d_phy: CALL xios_send_field for ', &
1285	trim(var%name), ' with iim jjm nlevx = ', &
1286	nbp_lon,jj_nb,nlevx
1287	ENDIF
1288	IF (grid_type==regular_lonlat) THEN
1289	IF (SIZE(field,1) == klon) then
1290	CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
1291	ELSE
1292	CALL xios_send_field(var%name, field)
1293	ENDIF
1294	ELSE IF (grid_type==unstructured) THEN
1295	IF (SIZE(field,1) == klon) then
1296	CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
1297	ELSE
1298	CALL xios_send_field(var%name, field)
1299	ENDIF
1300	ENDIF
1301
1302	firstx=.FALSE.
1303	ENDIF
1304	ENDIF
1305
1306	IF (.NOT.clef_stations(iff)) THEN
1307	ALLOCATE(index3d(nbp_lonjj_nbnlev))
1308	ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
1309
1310	#ifndef CPP_IOIPSL_NO_OUTPUT
1311	CALL histwrite(nid_files(iff),var%name,itau_iophy,Field3d,nbp_lonjj_nbnlev,index3d)
1312	#endif
1313
1314	! IF (using_xios) THEN
1315	! IF (iff == 1) THEN
1316	! CALL xios_send_field(var%name, Field3d(:,:,1:klev))
1317	! ENDIF
1318	! ENDIF
1319
1320	ELSE
1321	nlev=size(field,2)
1322	ALLOCATE(index3d(npstn*nlev))
1323	ALLOCATE(fieldok(npstn,nlev))
1324
1325	IF (is_sequential) THEN
1326	DO n=1, nlev
1327	DO ip=1, npstn
1328	fieldok(ip,n)=buffer_omp(nptabij(ip),n)
1329	ENDDO
1330	ENDDO
1331	ELSE
1332	DO n=1, nlev
1333	DO ip=1, npstn
1334	IF(nptabij(ip)>=klon_mpi_begin.AND. &
1335	nptabij(ip)<=klon_mpi_end) THEN
1336	fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
1337	ENDIF
1338	ENDDO
1339	ENDDO
1340	ENDIF
1341	#ifndef CPP_IOIPSL_NO_OUTPUT
1342	CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d)
1343	#endif
1344	ENDIF
1345	DEALLOCATE(index3d)
1346	DEALLOCATE(fieldok)
1347	ENDIF
1348	ENDDO
1349	ENDIF
1350	!$OMP END MASTER
1351	ENDIF ! vars_defined
1352
1353	IF (prt_level >= 10) write(lunout,*)'End histrwrite3d ',var%name
1354
1355	END SUBROUTINE histwrite3d_phy
1356
1357
1358	! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV
1359	SUBROUTINE histwrite2d_xios(field_name,field)
1360
1361	USE dimphy, ONLY: klon, klev
1362	USE lmdz_phys_para, ONLY: gather_omp, grid1Dto2D_mpi, &
1363	is_sequential, klon_mpi_begin, klon_mpi_end, &
1364	jj_nb, klon_mpi, is_master
1365	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, grid_type, unstructured
1366	USE lmdz_xios, ONLY: xios_send_field
1367	USE print_control_mod, ONLY: prt_level,lunout
1368	USE lmdz_abort_physic, ONLY: abort_physic
1369
1370	IMPLICIT NONE
1371
1372	CHARACTER(LEN=*), INTENT(IN) :: field_name
1373	REAL, DIMENSION(:), INTENT(IN) :: field
1374
1375	REAL,DIMENSION(klon_mpi) :: buffer_omp
1376	INTEGER, allocatable, DIMENSION(:) :: index2d
1377	REAL :: Field2d(nbp_lon,jj_nb)
1378
1379	INTEGER :: ip
1380	REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
1381
1382	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_xios for ', field_name
1383
1384	IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
1385
1386	!Et sinon on.... écrit
1387	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)
1388	IF (SIZE(field) == klev .OR. SIZE(field) == klev+1) then
1389	!$OMP MASTER
1390
1391	CALL xios_send_field(field_name,field)
1392	!$OMP END MASTER
1393	ELSE
1394	CALL Gather_omp(field,buffer_omp)
1395	!$OMP MASTER
1396
1397	IF (grid_type==unstructured) THEN
1398
1399	CALL xios_send_field(field_name, buffer_omp)
1400
1401	ELSE
1402
1403	CALL grid1Dto2D_mpi(buffer_omp,Field2d)
1404
1405	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1406	!ATTENTION, STATIONS PAS GEREES !
1407	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1408	!IF(.NOT.clef_stations(iff)) THEN
1409	IF (.TRUE.) THEN
1410
1411	CALL xios_send_field(field_name, Field2d)
1412
1413	ELSE
1414	ALLOCATE(fieldok(npstn))
1415	ALLOCATE(index2d(npstn))
1416
1417	IF (is_sequential) THEN
1418	DO ip=1, npstn
1419	fieldok(ip)=buffer_omp(nptabij(ip))
1420	ENDDO
1421	ELSE
1422	DO ip=1, npstn
1423	PRINT*,'histwrite2d_xios is_sequential npstn ip namenptabij',npstn,ip,field_name,nptabij(ip)
1424	IF(nptabij(ip)>=klon_mpi_begin.AND. &
1425	nptabij(ip)<=klon_mpi_end) THEN
1426	fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
1427	ENDIF
1428	ENDDO
1429	ENDIF
1430	DEALLOCATE(index2d)
1431	DEALLOCATE(fieldok)
1432
1433	ENDIF
1434	ENDIF
1435	!$OMP END MASTER
1436	ENDIF
1437
1438	IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',field_name
1439	END SUBROUTINE histwrite2d_xios
1440
1441
1442	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
1443	SUBROUTINE histwrite3d_xios(field_name, field)
1444
1445	USE dimphy, ONLY: klon, klev
1446	USE lmdz_phys_para, ONLY: gather_omp, grid1Dto2D_mpi, &
1447	is_sequential, klon_mpi_begin, klon_mpi_end, &
1448	jj_nb, klon_mpi, is_master
1449	USE lmdz_xios, ONLY: xios_send_field
1450	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, grid_type, unstructured
1451	USE print_control_mod, ONLY: prt_level,lunout
1452	USE lmdz_abort_physic, ONLY: abort_physic
1453
1454	IMPLICIT NONE
1455
1456	CHARACTER(LEN=*), INTENT(IN) :: field_name
1457	REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
1458
1459	REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
1460	REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
1461	INTEGER :: ip, n, nlev
1462	INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
1463	REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
1464
1465	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_xios for ', field_name
1466
1467	IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',field_name
1468
1469	!Et on.... écrit
1470	IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev .AND. SIZE(field,1)/=klev+1) then
1471	write(lunout,*)' histrwrite3d_xios ', field_name, SIZE(field)
1472	CALL abort_physic('iophy::histwrite3d_xios','Field first DIMENSION not equal to klon/klev',1)
1473	ENDIF
1474
1475	IF (SIZE(field,1) == klev .OR. SIZE(field,1) == klev+1) then
1476	!$OMP MASTER
1477	CALL xios_send_field(field_name,field)
1478	!$OMP END MASTER
1479	ELSE
1480	nlev=SIZE(field,2)
1481
1482
1483	CALL Gather_omp(field,buffer_omp)
1484	!$OMP MASTER
1485
1486	IF (grid_type==unstructured) THEN
1487
1488	CALL xios_send_field(field_name, buffer_omp(:,1:nlev))
1489
1490	ELSE
1491	CALL grid1Dto2D_mpi(buffer_omp,field3d)
1492
1493	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1494	!ATTENTION, STATIONS PAS GEREES !
1495	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1496	!IF (.NOT.clef_stations(iff)) THEN
1497	IF(.TRUE.)THEN
1498
1499	CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
1500
1501	ELSE
1502	nlev=size(field,2)
1503	ALLOCATE(index3d(npstn*nlev))
1504	ALLOCATE(fieldok(npstn,nlev))
1505
1506	IF (is_sequential) THEN
1507	DO n=1, nlev
1508	DO ip=1, npstn
1509	fieldok(ip,n)=buffer_omp(nptabij(ip),n)
1510	ENDDO
1511	ENDDO
1512	ELSE
1513	DO n=1, nlev
1514	DO ip=1, npstn
1515	IF(nptabij(ip)>=klon_mpi_begin.AND. &
1516	nptabij(ip)<=klon_mpi_end) THEN
1517	fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
1518	ENDIF
1519	ENDDO
1520	ENDDO
1521	ENDIF
1522	DEALLOCATE(index3d)
1523	DEALLOCATE(fieldok)
1524	ENDIF
1525	ENDIF
1526	!$OMP END MASTER
1527	ENDIF
1528
1529	IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',field_name
1530
1531	END SUBROUTINE histwrite3d_xios
1532
1533	SUBROUTINE histwrite0d_xios(field_name, field)
1534	USE lmdz_xios, ONLY: xios_send_field
1535	USE lmdz_phys_para, ONLY: is_master
1536	USE print_control_mod, ONLY: prt_level,lunout
1537	USE phys_output_var_mod, ONLY: vars_defined
1538
1539	IMPLICIT NONE
1540
1541	CHARACTER(LEN=*), INTENT(IN) :: field_name
1542	REAL, INTENT(IN) :: field ! --> scalar
1543
1544	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite0d_xios for ', field_name
1545
1546	IF (vars_defined) THEN
1547	!$OMP MASTER
1548	CALL xios_send_field(field_name, field)
1549	!$OMP END MASTER
1550	ENDIF
1551
1552	END SUBROUTINE histwrite0d_xios
1553
1554	END MODULE iophy

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

Download in other formats:

Original Format