Context Navigation

lmdz_cosp_output_write_mod.f90 @ 5440

Last change on this file since 5440 was 5316, checked in by abarral, 6 weeks ago
Fix clesphys import for cosp
File size: 41.0 KB

Line
1	!!!! Abderrahmane Idelkadi aout 2013 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2	! Module pour definir (au 1er appel) et ecrire les variables dans les fichiers de sortie cosp
3	!
4	! R.Guzman jan 2019 (mise a jour pour COSPv2)
5	! On change le nom du module a "lmdz_cosp_output_write_mod" et celui de la routine a "lmdz_cosp_output_write"
6	! pour qu on sache qu il s agit d un module specifique a l implementation de COSP dans LMDZ
7	!
8	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
9	MODULE lmdz_cosp_output_write_mod
10
11	USE lmdz_cosp_output_mod
12	USE mod_cosp_config, only : R_UNDEF, CLOUDSAT_DBZE_BINS, SR_BINS, PARASOL_NREFL, &
13	isccp_histPresCenters,tau_binCenters, LIDAR_NTEMP, &
14	LIDAR_PHASE_TEMP,misr_histHgtCenters,numMISRHgtBins, &
15	numMODISReffIceBins,reffICE_binCenters, &
16	numMODISReffLiqBins, reffLIQ_binCenters
17
18	IMPLICIT NONE
19
20	INTEGER, SAVE :: itau_iocosp
21	!$OMP THREADPRIVATE(itau_iocosp)
22	INTEGER, save :: Nlevout, Ncolout
23	!$OMP THREADPRIVATE(Nlevout, Ncolout)
24
25	! INTERFACE histwrite_cosp
26	! MODULE PROCEDURE histwrite2d_cosp,histwrite3d_cosp
27	! END INTERFACE
28
29	CONTAINS
30
31	SUBROUTINE lmdz_cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, missing_cosp, &
32	cfg, Nlvgrid, cospOUT)
33
34
35	USE ioipsl
36	USE time_phylmdz_mod, ONLY: itau_phy, start_time, day_step_phy
37	USE print_control_mod, ONLY: lunout,prt_level
38	USE lmdz_cosp_read_outputkeys, only: cosp_config
39	!COSPv2
40	use cosp_kinds, only: wp
41	use mod_cosp, only: cosp_outputs
42
43	use wxios_mod, only: wxios_closedef
44	USE lmdz_xios, only: xios_update_calendar, xios_field_is_active
45	IMPLICIT NONE
46	!!! Variables d'entree
47	integer :: itap, Nlevlmdz, Ncolumns, Npoints, Nlvgrid
48	real :: freq_COSP, dtime, missing_val, missing_cosp
49	type(cosp_config) :: cfg ! Control outputs
50	type(cosp_outputs) :: &
51	cospOUT ! COSP simulator outputs
52
53
54	!!! Variables locales
55	integer :: icl,k,ip
56	logical :: ok_sync
57	integer :: itau_wcosp, iff
58	real, dimension(Npoints,PARASOL_NREFL) :: parasolcrefl, Ncref
59
60	! Variables locals intermidiaires pour inverser les axes des champs 4D
61	! Compatibilite avec sorties CMIP
62	real, dimension(Npoints,Nlvgrid,SR_BINS) :: tmp_fi4da_cfadL, tmp_fi4da_cfadLgr, tmp_fi4da_cfadLatlid
63	real, dimension(Npoints,Nlvgrid,CLOUDSAT_DBZE_BINS) :: tmp_fi4da_cfadR
64	real, dimension(Npoints,numMISRHgtBins,7) :: tmp_fi4da_misr
65
66	missing_val=missing_cosp
67
68	Nlevout = Nlvgrid
69	Ncolout = Ncolumns
70
71	! A refaire
72	itau_wcosp = itau_phy + itap + start_time * day_step_phy
73	if (prt_level >= 10) then
74	WRITE(lunout,*)'itau_wcosp, itap, start_time, day_step_phy =', &
75	itau_wcosp, itap, start_time, day_step_phy
76	endif
77
78	! On le donne a cosp_output_write_mod pour que les histwrite y aient acces:
79	CALL set_itau_iocosp(itau_wcosp)
80	if (prt_level >= 10) then
81	WRITE(lunout,*)'itau_iocosp =',itau_iocosp
82	endif
83
84	ok_sync = .TRUE.
85
86	!!!! Sorties Calipso
87	if (cfg%Lcalipso) then
88
89	! print*,'Appel histwrite2d_cosp'
90	if (cfg%Lcllcalipso) then
91	where(cospOUT%calipso_cldlayer(:,1) == R_UNDEF) cospOUT%calipso_cldlayer(:,1) = missing_val
92	CALL histwrite2d_cosp(o_cllcalipso,cospOUT%calipso_cldlayer(:,1))
93	endif
94	if (cfg%Lclhcalipso) then
95	where(cospOUT%calipso_cldlayer(:,3) == R_UNDEF) cospOUT%calipso_cldlayer(:,3) = missing_val
96	CALL histwrite2d_cosp(o_clhcalipso,cospOUT%calipso_cldlayer(:,3))
97	endif
98	if (cfg%Lclmcalipso) then
99	where(cospOUT%calipso_cldlayer(:,2) == R_UNDEF) cospOUT%calipso_cldlayer(:,2) = missing_val
100	CALL histwrite2d_cosp(o_clmcalipso,cospOUT%calipso_cldlayer(:,2))
101	endif
102	if (cfg%Lcltcalipso) then
103	where(cospOUT%calipso_cldlayer(:,4) == R_UNDEF) cospOUT%calipso_cldlayer(:,4) = missing_val
104	CALL histwrite2d_cosp(o_cltcalipso,cospOUT%calipso_cldlayer(:,4))
105	endif
106	if (cfg%Lclcalipso) then
107	where(cospOUT%calipso_lidarcld == R_UNDEF) cospOUT%calipso_lidarcld = missing_val
108	CALL histwrite3d_cosp(o_clcalipso,cospOUT%calipso_lidarcld,nvert)
109	endif
110	if (cfg%Lclcalipsotmp) then
111	where(cospOUT%calipso_lidarcldtmp(:,:,1) == R_UNDEF) cospOUT%calipso_lidarcldtmp(:,:,1) = missing_val
112	CALL histwrite3d_cosp(o_clcalipsotmp,cospOUT%calipso_lidarcldtmp(:,:,1),nverttemp)
113	endif
114
115	if (cfg%Lcllcalipsoice) then
116	where(cospOUT%calipso_cldlayerphase(:,1,1) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,1,1) = missing_val
117	CALL histwrite2d_cosp(o_cllcalipsoice,cospOUT%calipso_cldlayerphase(:,1,1))
118	endif
119	if (cfg%Lclhcalipsoice) then
120	where(cospOUT%calipso_cldlayerphase(:,3,1) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,3,1) = missing_val
121	CALL histwrite2d_cosp(o_clhcalipsoice,cospOUT%calipso_cldlayerphase(:,3,1))
122	endif
123	if (cfg%Lclmcalipsoice) then
124	where(cospOUT%calipso_cldlayerphase(:,2,1) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,2,1) = missing_val
125	CALL histwrite2d_cosp(o_clmcalipsoice,cospOUT%calipso_cldlayerphase(:,2,1))
126	endif
127	if (cfg%Lcltcalipsoice) then
128	where(cospOUT%calipso_cldlayerphase(:,4,1) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,4,1) = missing_val
129	CALL histwrite2d_cosp(o_cltcalipsoice,cospOUT%calipso_cldlayerphase(:,4,1))
130	endif
131	if (cfg%Lclcalipsoice) then
132	where(cospOUT%calipso_lidarcldphase(:,:,1) == R_UNDEF) cospOUT%calipso_lidarcldphase(:,:,1) = missing_val
133	CALL histwrite3d_cosp(o_clcalipsoice,cospOUT%calipso_lidarcldphase(:,:,1),nvert)
134	endif
135	if (cfg%Lclcalipsotmpice) then
136	where(cospOUT%calipso_lidarcldtmp(:,:,2) == R_UNDEF) cospOUT%calipso_lidarcldtmp(:,:,2) = missing_val
137	CALL histwrite3d_cosp(o_clcalipsotmpice,cospOUT%calipso_lidarcldtmp(:,:,2),nverttemp)
138	endif
139
140	if (cfg%Lcllcalipsoliq) then
141	where(cospOUT%calipso_cldlayerphase(:,1,2) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,1,2) = missing_val
142	CALL histwrite2d_cosp(o_cllcalipsoliq,cospOUT%calipso_cldlayerphase(:,1,2))
143	endif
144	if (cfg%Lclhcalipsoliq) then
145	where(cospOUT%calipso_cldlayerphase(:,3,2) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,3,2) = missing_val
146	CALL histwrite2d_cosp(o_clhcalipsoliq,cospOUT%calipso_cldlayerphase(:,3,2))
147	endif
148	if (cfg%Lclmcalipsoliq) then
149	where(cospOUT%calipso_cldlayerphase(:,2,2) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,2,2) = missing_val
150	CALL histwrite2d_cosp(o_clmcalipsoliq,cospOUT%calipso_cldlayerphase(:,2,2))
151	endif
152	if (cfg%Lcltcalipsoliq) then
153	where(cospOUT%calipso_cldlayerphase(:,4,2) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,4,2) = missing_val
154	CALL histwrite2d_cosp(o_cltcalipsoliq,cospOUT%calipso_cldlayerphase(:,4,2))
155	endif
156	if (cfg%Lclcalipsoliq) then
157	where(cospOUT%calipso_lidarcldphase(:,:,2) == R_UNDEF) cospOUT%calipso_lidarcldphase(:,:,2) = missing_val
158	CALL histwrite3d_cosp(o_clcalipsoliq,cospOUT%calipso_lidarcldphase(:,:,2),nvert)
159	endif
160	if (cfg%Lclcalipsotmpliq) then
161	where(cospOUT%calipso_lidarcldtmp(:,:,3) == R_UNDEF) cospOUT%calipso_lidarcldtmp(:,:,3) = missing_val
162	CALL histwrite3d_cosp(o_clcalipsotmpliq,cospOUT%calipso_lidarcldtmp(:,:,3),nverttemp)
163	endif
164	if (cfg%Lcllcalipsoun) then
165	where(cospOUT%calipso_cldlayerphase(:,1,3) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,1,3) = missing_val
166	CALL histwrite2d_cosp(o_cllcalipsoun,cospOUT%calipso_cldlayerphase(:,1,3))
167	endif
168	if (cfg%Lclhcalipsoun) then
169	where(cospOUT%calipso_cldlayerphase(:,3,3) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,3,3) = missing_val
170	CALL histwrite2d_cosp(o_clhcalipsoun,cospOUT%calipso_cldlayerphase(:,3,3))
171	endif
172	if (cfg%Lclmcalipsoun) then
173	where(cospOUT%calipso_cldlayerphase(:,2,3) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,2,3) = missing_val
174	CALL histwrite2d_cosp(o_clmcalipsoun,cospOUT%calipso_cldlayerphase(:,2,3))
175	endif
176	if (cfg%Lcltcalipsoun) then
177	where(cospOUT%calipso_cldlayerphase(:,4,3) == R_UNDEF) cospOUT%calipso_cldlayerphase(:,4,3) = missing_val
178	CALL histwrite2d_cosp(o_cltcalipsoun,cospOUT%calipso_cldlayerphase(:,4,3))
179	endif
180	if (cfg%Lclcalipsoun) then
181	where(cospOUT%calipso_lidarcldphase(:,:,3) == R_UNDEF) cospOUT%calipso_lidarcldphase(:,:,3) = missing_val
182	CALL histwrite3d_cosp(o_clcalipsoun,cospOUT%calipso_lidarcldphase(:,:,3),nvert)
183	endif
184	if (cfg%Lclcalipsotmpun) then
185	where(cospOUT%calipso_lidarcldtmp(:,:,4) == R_UNDEF) cospOUT%calipso_lidarcldtmp(:,:,4) = missing_val
186	CALL histwrite3d_cosp(o_clcalipsotmpun,cospOUT%calipso_lidarcldtmp(:,:,4),nverttemp)
187	endif
188
189	if (cfg%Lclopaquecalipso) then
190	where(cospOUT%calipso_cldtype(:,1) == R_UNDEF) cospOUT%calipso_cldtype(:,1) = missing_val
191	CALL histwrite2d_cosp(o_clopaquecalipso,cospOUT%calipso_cldtype(:,1))
192	endif
193	if (cfg%Lclthincalipso) then
194	where(cospOUT%calipso_cldtype(:,2) == R_UNDEF) cospOUT%calipso_cldtype(:,2) = missing_val
195	CALL histwrite2d_cosp(o_clthincalipso,cospOUT%calipso_cldtype(:,2))
196	endif
197	if (cfg%Lclzopaquecalipso) then
198	where(cospOUT%calipso_cldtype(:,3) == R_UNDEF) cospOUT%calipso_cldtype(:,3) = missing_val
199	CALL histwrite2d_cosp(o_clzopaquecalipso,cospOUT%calipso_cldtype(:,3))
200	endif
201	if (cfg%Lclcalipsoopaque) then
202	where(cospOUT%calipso_lidarcldtype(:,:,1) == R_UNDEF) cospOUT%calipso_lidarcldtype(:,:,1) = missing_val
203	CALL histwrite3d_cosp(o_clcalipsoopaque,cospOUT%calipso_lidarcldtype(:,:,1),nvert)
204	endif
205	if (cfg%Lclcalipsothin) then
206	where(cospOUT%calipso_lidarcldtype(:,:,2) == R_UNDEF) cospOUT%calipso_lidarcldtype(:,:,2) = missing_val
207	CALL histwrite3d_cosp(o_clcalipsothin,cospOUT%calipso_lidarcldtype(:,:,2),nvert)
208	endif
209	if (cfg%Lclcalipsozopaque) then
210	where(cospOUT%calipso_lidarcldtype(:,:,3) == R_UNDEF) cospOUT%calipso_lidarcldtype(:,:,3) = missing_val
211	CALL histwrite3d_cosp(o_clcalipsozopaque,cospOUT%calipso_lidarcldtype(:,:,3),nvert)
212	endif
213	if (cfg%Lclcalipsoopacity) then
214	where(cospOUT%calipso_lidarcldtype(:,:,4) == R_UNDEF) cospOUT%calipso_lidarcldtype(:,:,4) = missing_val
215	CALL histwrite3d_cosp(o_clcalipsoopacity,cospOUT%calipso_lidarcldtype(:,:,4),nvert)
216	endif
217
218	if (cfg%Lclopaquetemp) then
219	where(cospOUT%calipso_cldtypetemp(:,1) == R_UNDEF) cospOUT%calipso_cldtypetemp(:,1) = missing_val
220	CALL histwrite2d_cosp(o_clopaquetemp,cospOUT%calipso_cldtypetemp(:,1))
221	endif
222	if (cfg%Lclthintemp) then
223	where(cospOUT%calipso_cldtypetemp(:,2) == R_UNDEF) cospOUT%calipso_cldtypetemp(:,2) = missing_val
224	CALL histwrite2d_cosp(o_clthintemp,cospOUT%calipso_cldtypetemp(:,2))
225	endif
226	if (cfg%Lclzopaquetemp) then
227	where(cospOUT%calipso_cldtypetemp(:,3) == R_UNDEF) cospOUT%calipso_cldtypetemp(:,3) = missing_val
228	CALL histwrite2d_cosp(o_clzopaquetemp,cospOUT%calipso_cldtypetemp(:,3))
229	endif
230	if (cfg%Lclopaquemeanz) then
231	where(cospOUT%calipso_cldtypemeanz(:,1) == R_UNDEF) cospOUT%calipso_cldtypemeanz(:,1) = missing_val
232	CALL histwrite2d_cosp(o_clopaquemeanz,cospOUT%calipso_cldtypemeanz(:,1))
233	endif
234	if (cfg%Lclthinmeanz) then
235	where(cospOUT%calipso_cldtypemeanz(:,2) == R_UNDEF) cospOUT%calipso_cldtypemeanz(:,2) = missing_val
236	CALL histwrite2d_cosp(o_clthinmeanz,cospOUT%calipso_cldtypemeanz(:,2))
237	endif
238	if (cfg%Lclthinemis) then
239	where(cospOUT%calipso_cldthinemis == R_UNDEF) cospOUT%calipso_cldthinemis = missing_val
240	CALL histwrite2d_cosp(o_clthinemis,cospOUT%calipso_cldthinemis)
241	endif
242	if (cfg%Lclopaquemeanzse) then
243	where(cospOUT%calipso_cldtypemeanzse(:,1) == R_UNDEF) cospOUT%calipso_cldtypemeanzse(:,1) = missing_val
244	CALL histwrite2d_cosp(o_clopaquemeanzse,cospOUT%calipso_cldtypemeanzse(:,1))
245	endif
246	if (cfg%Lclthinmeanzse) then
247	where(cospOUT%calipso_cldtypemeanzse(:,2) == R_UNDEF) cospOUT%calipso_cldtypemeanzse(:,2) = missing_val
248	CALL histwrite2d_cosp(o_clthinmeanzse,cospOUT%calipso_cldtypemeanzse(:,2))
249	endif
250	if (cfg%Lclzopaquecalipsose) then
251	where(cospOUT%calipso_cldtypemeanzse(:,3) == R_UNDEF) cospOUT%calipso_cldtypemeanzse(:,3) = missing_val
252	CALL histwrite2d_cosp(o_clzopaquecalipsose,cospOUT%calipso_cldtypemeanzse(:,3))
253	endif
254
255
256	if (cfg%LcfadLidarsr532) then
257	where(cospOUT%calipso_cfad_sr == R_UNDEF) cospOUT%calipso_cfad_sr = missing_val
258
259	do icl=1,SR_BINS
260	do k=1,Nlvgrid
261	do ip=1,Npoints
262	tmp_fi4da_cfadL(ip,k,icl)=cospOUT%calipso_cfad_sr(ip,icl,k)
263	enddo
264	enddo
265	enddo
266	! if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr)
267	CALL histwrite4d_cosp(o_cfadLidarsr532,tmp_fi4da_cfadL) !!! "_" enleve
268	endif
269
270	if (cfg%Latb532) then
271	where(cospOUT%calipso_beta_tot == R_UNDEF) cospOUT%calipso_beta_tot = missing_val
272	CALL histwrite4d_cosp(o_atb532,cospOUT%calipso_beta_tot)
273	endif
274	if (cfg%LlidarBetaMol532) then
275	where(cospOUT%calipso_beta_mol == R_UNDEF) cospOUT%calipso_beta_mol = missing_val
276	CALL histwrite3d_cosp(o_lidarBetaMol532,cospOUT%calipso_beta_mol,nvertmcosp)
277	endif
278
279	endif !Calipso
280
281
282	!!!! Sorties Ground Lidar
283	if (cfg%LgrLidar532) then
284	! AI juin 2020 Voir a quoi correspond ce champs
285	! where(cospOUT%grLidar532_srbval == R_UNDEF) cospOUT%grLidar532_srbval = missing_val
286
287	if (cfg%LcllgrLidar532) then
288	where(cospOUT%grLidar532_cldlayer(:,1) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,1) = missing_val
289	CALL histwrite2d_cosp(o_cllgrLidar532,cospOUT%grLidar532_cldlayer(:,1))
290	endif
291	if (cfg%LclmgrLidar532) then
292	where(cospOUT%grLidar532_cldlayer(:,2) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,2) = missing_val
293	CALL histwrite2d_cosp(o_clmgrLidar532,cospOUT%grLidar532_cldlayer(:,2))
294	endif
295	if (cfg%LclhgrLidar532) then
296	where(cospOUT%grLidar532_cldlayer(:,3) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,3) = missing_val
297	CALL histwrite2d_cosp(o_clhgrLidar532,cospOUT%grLidar532_cldlayer(:,3))
298	endif
299	if (cfg%LcltgrLidar532) then
300	where(cospOUT%grLidar532_cldlayer(:,4) == R_UNDEF) cospOUT%grLidar532_cldlayer(:,4) = missing_val
301	CALL histwrite2d_cosp(o_cltgrLidar532,cospOUT%grLidar532_cldlayer(:,4))
302	endif
303
304	if (cfg%LclgrLidar532) then
305	where(cospOUT%grLidar532_lidarcld == R_UNDEF) cospOUT%grLidar532_lidarcld = missing_val
306	CALL histwrite3d_cosp(o_clgrLidar532,cospOUT%grLidar532_lidarcld,nvert)
307	endif
308	if (cfg%LlidarBetaMol532gr) then
309	where(cospOUT%grLidar532_beta_mol == R_UNDEF) cospOUT%grLidar532_beta_mol = missing_val
310	CALL histwrite3d_cosp(o_lidarBetaMol532gr,cospOUT%grLidar532_beta_mol,nvertmcosp)
311	endif
312	if (cfg%LcfadLidarsr532gr) then
313	where(cospOUT%grLidar532_cfad_sr == R_UNDEF) cospOUT%grLidar532_cfad_sr = missing_val
314	do icl=1,SR_BINS
315	do k=1,Nlvgrid
316	do ip=1,Npoints
317	tmp_fi4da_cfadLgr(ip,k,icl)=cospOUT%grLidar532_cfad_sr(ip,icl,k)
318	enddo
319	enddo
320	enddo
321	CALL histwrite4d_cosp(o_cfadLidarsr532gr,tmp_fi4da_cfadLgr)
322	endif
323
324	if (cfg%Latb532gr) then
325	where(cospOUT%grLidar532_beta_tot == R_UNDEF) cospOUT%grLidar532_beta_tot = missing_val
326	CALL histwrite4d_cosp(o_atb532gr,cospOUT%grLidar532_beta_tot)
327	endif
328	endif ! Ground Lidar 532 nm
329
330
331	!!!! Sorties Atlid
332	if (cfg%Latlid) then
333	! AI juin 2020 Voir a quoi correspond ce champs
334	! where(cospOUT%atlid_srbval == R_UNDEF) cospOUT%atlid_srbval = missing_val
335
336	if (cfg%Lcllatlid) then
337	where(cospOUT%atlid_cldlayer(:,1) == R_UNDEF) cospOUT%atlid_cldlayer(:,1) = missing_val
338	CALL histwrite2d_cosp(o_cllatlid,cospOUT%atlid_cldlayer(:,1))
339	endif
340	if (cfg%Lclmatlid) then
341	where(cospOUT%atlid_cldlayer(:,2) == R_UNDEF) cospOUT%atlid_cldlayer(:,2) = missing_val
342	CALL histwrite2d_cosp(o_clmatlid,cospOUT%atlid_cldlayer(:,2))
343	endif
344	if (cfg%Lclhatlid) then
345	where(cospOUT%atlid_cldlayer(:,3) == R_UNDEF) cospOUT%atlid_cldlayer(:,3) = missing_val
346	CALL histwrite2d_cosp(o_clhatlid,cospOUT%atlid_cldlayer(:,3))
347	endif
348	if (cfg%Lcltatlid) then
349	where(cospOUT%atlid_cldlayer(:,4) == R_UNDEF) cospOUT%atlid_cldlayer(:,4) = missing_val
350	CALL histwrite2d_cosp(o_cltatlid,cospOUT%atlid_cldlayer(:,4))
351	endif
352	if (cfg%Lclatlid) then
353	where(cospOUT%atlid_lidarcld == R_UNDEF) cospOUT%atlid_lidarcld = missing_val
354	CALL histwrite3d_cosp(o_clatlid,cospOUT%atlid_lidarcld,nvert)
355	endif
356	if (cfg%LlidarBetaMol355) then
357	where(cospOUT%atlid_beta_mol == R_UNDEF) cospOUT%atlid_beta_mol = missing_val
358	CALL histwrite3d_cosp(o_lidarBetaMol355,cospOUT%atlid_beta_mol,nvertmcosp)
359	endif
360	if (cfg%LcfadLidarsr355) then
361	where(cospOUT%atlid_cfad_sr == R_UNDEF) cospOUT%atlid_cfad_sr = missing_val
362	do icl=1,SR_BINS
363	do k=1,Nlvgrid
364	do ip=1,Npoints
365	tmp_fi4da_cfadLatlid(ip,k,icl)=cospOUT%atlid_cfad_sr(ip,icl,k)
366	enddo
367	enddo
368	enddo
369	CALL histwrite4d_cosp(o_cfadlidarsr355,tmp_fi4da_cfadLatlid)
370	endif
371
372	if (cfg%Latb355) then
373	where(cospOUT%atlid_beta_tot == R_UNDEF) cospOUT%atlid_beta_tot = missing_val
374	CALL histwrite4d_cosp(o_atb355,cospOUT%atlid_beta_tot)
375	endif
376	endif ! Atlid
377
378
379	if (cfg%Lparasol) then
380	if (cfg%LparasolRefl) then
381	where(cospOUT%parasolGrid_refl == R_UNDEF) cospOUT%parasolGrid_refl = missing_val
382	where(cospOUT%parasolPix_refl == R_UNDEF) cospOUT%parasolPix_refl = missing_val
383	CALL histwrite3d_cosp(o_parasolGrid_refl,cospOUT%parasolGrid_refl,nvertp)
384	CALL histwrite4d_cosp(o_parasolPix_refl,cospOUT%parasolPix_refl)
385	endif ! LparasolRefl
386	endif ! Parasol
387
388	! if (cfg%LparasolRefl) then
389	! do k=1,PARASOL_NREFL
390	! do ip=1, Npoints
391	! if (stlidar%cldlayer(ip,4).gt.1.and.stlidar%parasolrefl(ip,k).ne.missing_val) then
392	! parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)/100.))/ &
393	! (stlidar%cldlayer(ip,4)/100.)
394	! Ncref(ip,k) = 1.
395	! else
396	! parasolcrefl(ip,k)=missing_val
397	! Ncref(ip,k) = 0.
398	! endif
399	! enddo
400	! enddo
401	! CALL histwrite3d_cosp(o_Ncrefl,Ncref,nvertp)
402	! CALL histwrite3d_cosp(o_parasol_crefl,parasolcrefl,nvertp)
403	! endif
404
405
406	!!! Sorties CloudSat
407	if (cfg%Lcloudsat) then
408	! AI juin 2020 voir a quoi correspond ce champs
409	! where(cospOUT%cloudsat_pia == R_UNDEF) cospOUT%cloudsat_pia = missing_val
410
411	if (cfg%Lptradarflag0) then
412	where(cospOUT%cloudsat_precip_cover(:,1) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,1) = missing_val
413	CALL histwrite2d_cosp(o_ptradarflag0,cospOUT%cloudsat_precip_cover(:,1))
414	endif
415	if (cfg%Lptradarflag1) then
416	where(cospOUT%cloudsat_precip_cover(:,2) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,2) = missing_val
417	CALL histwrite2d_cosp(o_ptradarflag1,cospOUT%cloudsat_precip_cover(:,2))
418	endif
419	if (cfg%Lptradarflag2) then
420	where(cospOUT%cloudsat_precip_cover(:,3) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,3) = missing_val
421	CALL histwrite2d_cosp(o_ptradarflag2,cospOUT%cloudsat_precip_cover(:,3))
422	endif
423	if (cfg%Lptradarflag3) then
424	where(cospOUT%cloudsat_precip_cover(:,4) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,4) = missing_val
425	CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,4))
426	endif
427	if (cfg%Lptradarflag4) then
428	where(cospOUT%cloudsat_precip_cover(:,5) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,5) = missing_val
429	CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,5))
430	endif
431	if (cfg%Lptradarflag5) then
432	where(cospOUT%cloudsat_precip_cover(:,6) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,6) = missing_val
433	CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,6))
434	endif
435	if (cfg%Lptradarflag6) then
436	where(cospOUT%cloudsat_precip_cover(:,7) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,7) = missing_val
437	CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,7))
438	endif
439	if (cfg%Lptradarflag7) then
440	where(cospOUT%cloudsat_precip_cover(:,8) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,8) = missing_val
441	CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,8))
442	endif
443	if (cfg%Lptradarflag8) then
444	where(cospOUT%cloudsat_precip_cover(:,9) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,9) = missing_val
445	CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,9))
446	endif
447	if (cfg%Lptradarflag9) then
448	where(cospOUT%cloudsat_precip_cover(:,10) == R_UNDEF) cospOUT%cloudsat_precip_cover(:,10) = missing_val
449	CALL histwrite2d_cosp(o_ptradarflag3,cospOUT%cloudsat_precip_cover(:,10))
450	endif
451
452	if (cfg%Ldbze94) then
453	where(cospOUT%cloudsat_Ze_tot == R_UNDEF) cospOUT%cloudsat_Ze_tot = missing_val
454	CALL histwrite4d_cosp(o_dbze94,cospOUT%cloudsat_Ze_tot)
455	endif
456	if (cfg%LcfadDbze94) then
457	where(cospOUT%cloudsat_cfad_ze == R_UNDEF) cospOUT%cloudsat_cfad_ze = missing_val
458	do icl=1,CLOUDSAT_DBZE_BINS
459	do k=1,Nlvgrid
460	do ip=1,Npoints
461	tmp_fi4da_cfadR(ip,k,icl)=cospOUT%cloudsat_cfad_ze(ip,icl,k)
462	enddo
463	enddo
464	enddo
465	CALL histwrite4d_cosp(o_cfadDbze94,tmp_fi4da_cfadR)
466	endif
467	endif
468	! endif pour CloudSat
469
470
471	!!! Sorties combinees Cloudsat et Calipso
472	if (cfg%Lcalipso .and. cfg%Lcloudsat) then
473
474	if (cfg%Lclcalipso2) then
475	where(cospOUT%lidar_only_freq_cloud == R_UNDEF) &
476	cospOUT%lidar_only_freq_cloud = missing_val
477	CALL histwrite3d_cosp(o_clcalipso2,cospOUT%lidar_only_freq_cloud,nvert)
478	endif
479	if (cfg%Lcloudsat_tcc) then
480	where(cospOUT%cloudsat_tcc == R_UNDEF) &
481	cospOUT%cloudsat_tcc = missing_val
482	CALL histwrite2d_cosp(o_cloudsat_tcc,cospOUT%cloudsat_tcc)
483	endif
484	if (cfg%Lcloudsat_tcc2) then
485	where(cospOUT%cloudsat_tcc2 == R_UNDEF) &
486	cospOUT%cloudsat_tcc2 = missing_val
487	CALL histwrite2d_cosp(o_cloudsat_tcc2,cospOUT%cloudsat_tcc2)
488	endif
489	if (cfg%Lcltlidarradar) then
490	where(cospOUT%radar_lidar_tcc == R_UNDEF) &
491	cospOUT%radar_lidar_tcc = missing_val
492	CALL histwrite2d_cosp(o_cltlidarradar,cospOUT%radar_lidar_tcc)
493	endif
494	endif
495
496
497	!!! Sorties Isccp
498	if (cfg%Lisccp) then
499	where(cospOUT%isccp_totalcldarea == R_UNDEF) cospOUT%isccp_totalcldarea = missing_val
500	where(cospOUT%isccp_meanptop == R_UNDEF) cospOUT%isccp_meanptop = missing_val
501	where(cospOUT%isccp_meantaucld == R_UNDEF) cospOUT%isccp_meantaucld = missing_val
502	where(cospOUT%isccp_meanalbedocld == R_UNDEF) cospOUT%isccp_meanalbedocld = missing_val
503	where(cospOUT%isccp_meantb == R_UNDEF) cospOUT%isccp_meantb = missing_val
504	where(cospOUT%isccp_meantbclr == R_UNDEF) cospOUT%isccp_meantbclr = missing_val
505	where(cospOUT%isccp_fq == R_UNDEF) cospOUT%isccp_fq = missing_val
506	where(cospOUT%isccp_boxtau == R_UNDEF) cospOUT%isccp_boxtau = missing_val
507	where(cospOUT%isccp_boxptop == R_UNDEF) cospOUT%isccp_boxptop = missing_val
508
509	! CALL histwrite2d_cosp(o_sunlit,gbx%sunlit)
510	if (cfg%Lclisccp) CALL histwrite4d_cosp(o_clisccp,cospOUT%isccp_fq)
511
512	if (cfg%Lboxtauisccp) CALL histwrite3d_cosp(o_boxtauisccp,cospOUT%isccp_boxtau,nvertcol)
513	if (cfg%Lboxptopisccp) CALL histwrite3d_cosp(o_boxptopisccp,cospOUT%isccp_boxptop,nvertcol)
514	if (cfg%Lcltisccp) CALL histwrite2d_cosp(o_cltisccp,cospOUT%isccp_totalcldarea)
515	if (cfg%Lpctisccp) CALL histwrite2d_cosp(o_pctisccp,cospOUT%isccp_meanptop)
516	if (cfg%Ltauisccp) CALL histwrite2d_cosp(o_tauisccp,cospOUT%isccp_meantaucld)
517	if (cfg%Lalbisccp) CALL histwrite2d_cosp(o_albisccp,cospOUT%isccp_meanalbedocld)
518	if (cfg%Lmeantbisccp) CALL histwrite2d_cosp(o_meantbisccp,cospOUT%isccp_meantb)
519	if (cfg%Lmeantbclrisccp) CALL histwrite2d_cosp(o_meantbclrisccp,cospOUT%isccp_meantbclr)
520	endif ! Isccp
521
522
523	!!! MISR simulator
524	if (cfg%Lmisr) then
525
526	if (cfg%LclMISR) then
527	! Ces 3 diagnostics sont controles par la clef logique "LclMISR"
528	where(cospOUT%misr_fq == R_UNDEF) cospOUT%misr_fq = missing_val
529	! where(cospOUT%misr_dist_model_layertops == R_UNDEF) cospOUT%misr_dist_model_layertops = missing_val
530	where(cospOUT%misr_meanztop == R_UNDEF) cospOUT%misr_meanztop = missing_val
531	where(cospOUT%misr_cldarea == R_UNDEF) cospOUT%misr_cldarea = missing_val
532
533	do icl=1,numMISRHgtBins
534	do k=1,Nlvgrid
535	do ip=1,Npoints
536	tmp_fi4da_misr(ip,icl,k)=cospOUT%misr_fq(ip,k,icl)
537	enddo
538	enddo
539	enddo
540	! if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,misr%fq_MISR)
541	! if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,tmp_fi4da_misr)
542	CALL histwrite4d_cosp(o_misr_fq,tmp_fi4da_misr)
543
544	CALL histwrite2d_cosp(o_misr_meanztop,cospOUT%misr_meanztop)
545	CALL histwrite2d_cosp(o_misr_cldarea,cospOUT%misr_cldarea)
546	endif ! LclMISR
547
548	endif ! Misr
549
550
551	!!! Modis simulator
552	if (cfg%Lmodis) then
553	where(cospOUT%modis_Cloud_Fraction_Low_Mean == R_UNDEF) &
554	cospOUT%modis_Cloud_Fraction_Low_Mean = missing_val
555	where(cospOUT%modis_Cloud_Fraction_High_Mean == R_UNDEF) &
556	cospOUT%modis_Cloud_Fraction_High_Mean = missing_val
557	where(cospOUT%modis_Cloud_Fraction_Mid_Mean == R_UNDEF) &
558	cospOUT%modis_Cloud_Fraction_Mid_Mean = missing_val
559	where(cospOUT%modis_Cloud_Fraction_Total_Mean == R_UNDEF) &
560	cospOUT%modis_Cloud_Fraction_Total_Mean = missing_val
561	where(cospOUT%modis_Cloud_Fraction_Water_Mean == R_UNDEF) &
562	cospOUT%modis_Cloud_Fraction_Water_Mean = missing_val
563	where(cospOUT%modis_Cloud_Fraction_Ice_Mean == R_UNDEF) &
564	cospOUT%modis_Cloud_Fraction_Ice_Mean = missing_val
565	where(cospOUT%modis_Optical_Thickness_Total_Mean == R_UNDEF) &
566	cospOUT%modis_Optical_Thickness_Total_Mean = missing_val
567	where(cospOUT%modis_Optical_Thickness_Water_Mean == R_UNDEF) &
568	cospOUT%modis_Optical_Thickness_Water_Mean = missing_val
569	where(cospOUT%modis_Optical_Thickness_Ice_Mean == R_UNDEF) &
570	cospOUT%modis_Optical_Thickness_Ice_Mean = missing_val
571	where(cospOUT%modis_Cloud_Particle_Size_Water_Mean == R_UNDEF) &
572	cospOUT%modis_Cloud_Particle_Size_Water_Mean = missing_val
573	where(cospOUT%modis_Cloud_Particle_Size_Ice_Mean == R_UNDEF) &
574	cospOUT%modis_Cloud_Particle_Size_Ice_Mean = missing_val
575	where(cospOUT%modis_Cloud_Top_Pressure_Total_Mean == R_UNDEF) &
576	cospOUT%modis_Cloud_Top_Pressure_Total_Mean = missing_val
577	where(cospOUT%modis_Liquid_Water_Path_Mean == R_UNDEF) &
578	cospOUT%modis_Liquid_Water_Path_Mean = missing_val
579	where(cospOUT%modis_Ice_Water_Path_Mean == R_UNDEF) &
580	cospOUT%modis_Ice_Water_Path_Mean = missing_val
581	where(cospOUT%modis_Optical_Thickness_Total_LogMean == R_UNDEF) &
582	cospOUT%modis_Optical_Thickness_Total_LogMean = missing_val
583	where(cospOUT%modis_Optical_Thickness_Water_LogMean == R_UNDEF) &
584	cospOUT%modis_Optical_Thickness_Water_LogMean = missing_val
585	where(cospOUT%modis_Optical_Thickness_Ice_LogMean == R_UNDEF) &
586	cospOUT%modis_Optical_Thickness_Ice_LogMean = missing_val
587
588	if (cfg%Lcllmodis) CALL histwrite2d_cosp(o_cllmodis,cospOUT%modis_Cloud_Fraction_Low_Mean)
589	if (cfg%Lclhmodis) CALL histwrite2d_cosp(o_clhmodis,cospOUT%modis_Cloud_Fraction_High_Mean)
590	if (cfg%Lclmmodis) CALL histwrite2d_cosp(o_clmmodis,cospOUT%modis_Cloud_Fraction_Mid_Mean)
591	if (cfg%Lcltmodis) CALL histwrite2d_cosp(o_cltmodis,cospOUT%modis_Cloud_Fraction_Total_Mean)
592	if (cfg%Lclwmodis) CALL histwrite2d_cosp(o_clwmodis,cospOUT%modis_Cloud_Fraction_Water_Mean)
593	if (cfg%Lclimodis) CALL histwrite2d_cosp(o_climodis,cospOUT%modis_Cloud_Fraction_Ice_Mean)
594	if (cfg%Ltautmodis) CALL histwrite2d_cosp(o_tautmodis,cospOUT%modis_Optical_Thickness_Total_Mean)
595	if (cfg%Ltauwmodis) CALL histwrite2d_cosp(o_tauwmodis,cospOUT%modis_Optical_Thickness_Water_Mean)
596	if (cfg%Ltauimodis) CALL histwrite2d_cosp(o_tauimodis,cospOUT%modis_Optical_Thickness_Ice_Mean)
597	if (cfg%Ltautlogmodis) CALL histwrite2d_cosp(o_tautlogmodis,cospOUT%modis_Optical_Thickness_Total_LogMean)
598	if (cfg%Ltauwlogmodis) CALL histwrite2d_cosp(o_tauwlogmodis,cospOUT%modis_Optical_Thickness_Water_LogMean)
599	if (cfg%Ltauilogmodis) CALL histwrite2d_cosp(o_tauilogmodis,cospOUT%modis_Optical_Thickness_Ice_LogMean)
600	if (cfg%Lreffclwmodis) CALL histwrite2d_cosp(o_reffclwmodis,cospOUT%modis_Cloud_Particle_Size_Water_Mean)
601	if (cfg%Lreffclimodis) CALL histwrite2d_cosp(o_reffclimodis,cospOUT%modis_Cloud_Particle_Size_Ice_Mean)
602	if (cfg%Lpctmodis) CALL histwrite2d_cosp(o_pctmodis,cospOUT%modis_Cloud_Top_Pressure_Total_Mean)
603	if (cfg%Llwpmodis) CALL histwrite2d_cosp(o_lwpmodis,cospOUT%modis_Liquid_Water_Path_Mean)
604	if (cfg%Liwpmodis) CALL histwrite2d_cosp(o_iwpmodis,cospOUT%modis_Ice_Water_Path_Mean)
605
606	if (cfg%Lclmodis) then
607	! Ces 3 diagnostics sont controles par la clef logique "Lclmodis"
608	where(cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure == R_UNDEF) &
609	cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure = missing_val
610	where(cospOUT%modis_Optical_Thickness_vs_ReffICE == R_UNDEF) &
611	cospOUT%modis_Optical_Thickness_vs_ReffICE = missing_val
612	where(cospOUT%modis_Optical_thickness_vs_ReffLIQ == R_UNDEF) &
613	cospOUT%modis_Optical_thickness_vs_ReffLIQ = missing_val
614
615	CALL histwrite4d_cosp(o_modis_ot_vs_ctp,cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure)
616	CALL histwrite4d_cosp(o_modis_ot_vs_reffice,cospOUT%modis_Optical_Thickness_vs_ReffICE)
617	CALL histwrite4d_cosp(o_modis_ot_vs_reffliq,cospOUT%modis_Optical_thickness_vs_ReffLIQ)
618
619	endif ! Lclmodis
620
621	endif !modis
622
623
624	IF(.NOT.cosp_varsdefined) THEN
625	!$OMP MASTER
626	! Fermeture dans phys_output_write
627	!#ifdef 1
628	!On finalise l'initialisation:
629	!CALL wxios_closedef()
630	!#endif
631
632	!$OMP END MASTER
633	!$OMP BARRIER
634	cosp_varsdefined = .TRUE.
635	END IF
636
637	IF(cosp_varsdefined) THEN
638	! On synchronise les fichiers pour IOIPSL
639	ENDIF !cosp_varsdefined
640
641	END SUBROUTINE lmdz_cosp_output_write
642
643
644	! ug Routine pour definir itau_iocosp depuis cosp_output_write_mod:
645	SUBROUTINE set_itau_iocosp(ito)
646	USE clesphys_mod_h
647	IMPLICIT NONE
648	INTEGER, INTENT(IN) :: ito
649	itau_iocosp = ito
650	END SUBROUTINE
651
652	SUBROUTINE histdef2d_cosp (iff,var)
653
654	USE ioipsl
655	USE dimphy
656	use iophy
657	USE mod_phys_lmdz_para
658	USE mod_grid_phy_lmdz, ONLY: nbp_lon
659	USE print_control_mod, ONLY: lunout,prt_level
660	use wxios_mod
661	USE clesphys_mod_h, ONLY: ok_all_xml
662
663	IMPLICIT NONE
664
665
666	INTEGER :: iff
667	TYPE(ctrl_outcosp) :: var
668
669	REAL zstophym
670	CHARACTER(LEN=20) :: typeecrit
671
672	! ug On récupère le type écrit de la structure:
673	! Assez moche, �\| refaire si meilleure méthode...
674	IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
675	typeecrit = 'once'
676	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
677	typeecrit = 't_min(X)'
678	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
679	typeecrit = 't_max(X)'
680	ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
681	typeecrit = 'inst(X)'
682	ELSE
683	typeecrit = cosp_outfiletypes(iff)
684	ENDIF
685
686	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
687	zstophym=zoutm_cosp(iff)
688	ELSE
689	zstophym=zdtimemoy_cosp
690	ENDIF
691
692	IF (.not. ok_all_xml) then
693	IF ( var%cles(iff) ) THEN
694	if (prt_level >= 10) then
695	WRITE(lunout,*)'Appel wxios_add_field_to_file var%name =',var%name
696	endif
697	CALL wxios_add_field_to_file(var%name, 2, cosp_nidfiles(iff), cosp_outfilenames(iff), &
698	var%description, var%unit, 1, typeecrit)
699	ENDIF
700	ENDIF
701
702
703	END SUBROUTINE histdef2d_cosp
704
705
706	SUBROUTINE histdef3d_cosp (iff,var,nvertsave,ncols)
707	USE clesphys_mod_h
708	USE ioipsl
709	USE dimphy
710	use iophy
711	USE mod_phys_lmdz_para
712	USE mod_grid_phy_lmdz, ONLY: nbp_lon
713	USE print_control_mod, ONLY: lunout,prt_level
714
715	use wxios_mod
716
717
718	IMPLICIT NONE
719
720
721	INTEGER :: iff, klevs
722	INTEGER, INTENT(IN), OPTIONAL :: ncols ! ug RUSTINE POUR LES variables 4D
723	INTEGER, INTENT(IN) :: nvertsave
724	TYPE(ctrl_outcosp) :: var
725
726	REAL zstophym
727	CHARACTER(LEN=20) :: typeecrit, nomi
728	CHARACTER(LEN=20) :: nom
729	character(len=2) :: str2
730	CHARACTER(len=20) :: nam_axvert
731
732	! Axe vertical
733	IF (nvertsave.eq.nvertp(iff)) THEN
734	klevs=PARASOL_NREFL
735	nam_axvert="sza"
736	ELSE IF (nvertsave.eq.nvertisccp(iff)) THEN
737	klevs=7
738	nam_axvert="pressure2"
739	ELSE IF (nvertsave.eq.nvertcol(iff)) THEN
740	klevs=Ncolout
741	nam_axvert="column"
742	ELSE IF (nvertsave.eq.nverttemp(iff)) THEN
743	klevs=LIDAR_NTEMP
744	nam_axvert="temp"
745	ELSE IF (nvertsave.eq.nvertmisr(iff)) THEN
746	klevs=numMISRHgtBins
747	nam_axvert="cth16"
748	ELSE IF (nvertsave.eq.nvertReffIce(iff)) THEN
749	klevs= numMODISReffIceBins
750	nam_axvert="ReffIce"
751	ELSE IF (nvertsave.eq.nvertReffLiq(iff)) THEN
752	klevs= numMODISReffLiqBins
753	nam_axvert="ReffLiq"
754	ELSE
755	klevs=Nlevout
756	nam_axvert="presnivs"
757	ENDIF
758
759	! ug RUSTINE POUR LES Champs 4D
760	IF (PRESENT(ncols)) THEN
761	write(str2,'(i2.2)')ncols
762	nomi=var%name
763	nom="c"//str2//"_"//nomi
764	ELSE
765	nom=var%name
766	END IF
767
768	! ug On récupère le type écrit de la structure:
769	! Assez moche, �\| refaire si meilleure méthode...
770	IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
771	typeecrit = 'once'
772	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
773	typeecrit = 't_min(X)'
774	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
775	typeecrit = 't_max(X)'
776	ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
777	typeecrit = 'inst(X)'
778	ELSE
779	typeecrit = cosp_outfiletypes(iff)
780	ENDIF
781
782	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
783	zstophym=zoutm_cosp(iff)
784	ELSE
785	zstophym=zdtimemoy_cosp
786	ENDIF
787
788	IF (.not. ok_all_xml) then
789	IF ( var%cles(iff) ) THEN
790	if (prt_level >= 10) then
791	WRITE(lunout,*)'Appel wxios_add_field_to_file 3d nom variable nam_axvert = ',nom, nam_axvert
792	endif
793	CALL wxios_add_field_to_file(nom, 3, cosp_nidfiles(iff), cosp_outfilenames(iff), &
794	var%description, var%unit, 1, typeecrit, nam_axvert)
795	ENDIF
796	ENDIF
797
798
799	END SUBROUTINE histdef3d_cosp
800
801
802	SUBROUTINE histwrite2d_cosp(var,field)
803	USE clesphys_mod_h
804	USE dimphy
805	USE mod_phys_lmdz_para
806	USE ioipsl
807	use iophy
808	USE mod_grid_phy_lmdz, ONLY: nbp_lon
809	USE print_control_mod, ONLY: lunout,prt_level
810
811	USE lmdz_xios, only: xios_send_field
812
813	IMPLICIT NONE
814
815	TYPE(ctrl_outcosp), INTENT(IN) :: var
816	REAL, DIMENSION(:), INTENT(IN) :: field
817
818	INTEGER :: iff
819
820	REAL,DIMENSION(klon_mpi) :: buffer_omp
821	INTEGER, allocatable, DIMENSION(:) :: index2d
822	REAL :: Field2d(nbp_lon,jj_nb)
823	CHARACTER(LEN=20) :: nomi, nom
824	character(len=2) :: str2
825	LOGICAL, SAVE :: firstx
826	!$OMP THREADPRIVATE(firstx)
827
828	IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
829
830	! On regarde si on est dans la phase de définition ou d'écriture:
831	IF(.NOT.cosp_varsdefined) THEN
832	!$OMP MASTER
833	print*,'var, cosp_varsdefined dans cosp_varsdefined ',var%name, cosp_varsdefined
834	!Si phase de définition.... on définit
835	CALL conf_cospoutputs(var%name,var%cles)
836	DO iff=1, 3
837	IF (cosp_outfilekeys(iff)) THEN
838	CALL histdef2d_cosp(iff, var)
839	ENDIF
840	ENDDO
841	!$OMP END MASTER
842	ELSE
843	!Et sinon on.... écrit
844	IF (SIZE(field)/=klon) &
845	CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1)
846
847	CALL Gather_omp(field,buffer_omp)
848	!$OMP MASTER
849	CALL grid1Dto2D_mpi(buffer_omp,Field2d)
850
851	! La boucle sur les fichiers:
852	firstx=.true.
853	DO iff=1, 3
854	IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
855	ALLOCATE(index2d(nbp_lon*jj_nb))
856	deallocate(index2d)
857	IF (.not. ok_all_xml) then
858	if (firstx) then
859	if (prt_level >= 10) then
860	WRITE(lunout,*)'xios_send_field variable ',var%name
861	endif
862	CALL xios_send_field(var%name, Field2d)
863	firstx=.false.
864	endif
865	ENDIF
866	ENDIF
867	ENDDO
868
869	IF (ok_all_xml) THEN
870	if (prt_level >= 1) then
871	WRITE(lunout,*)'xios_send_field variable ',var%name
872	endif
873	CALL xios_send_field(var%name, Field2d)
874	ENDIF
875
876	!$OMP END MASTER
877	ENDIF ! vars_defined
878	IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_cosp ',var%name
879	END SUBROUTINE histwrite2d_cosp
880
881
882	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
883	! AI sept 2013
884	SUBROUTINE histwrite3d_cosp(var, field, nverts, ncols)
885	USE clesphys_mod_h
886	USE dimphy
887	USE mod_phys_lmdz_para
888	USE ioipsl
889	use iophy
890	USE mod_grid_phy_lmdz, ONLY: nbp_lon
891	USE print_control_mod, ONLY: lunout,prt_level
892
893	USE lmdz_xios, only: xios_send_field
894
895
896	IMPLICIT NONE
897
898	TYPE(ctrl_outcosp), INTENT(IN) :: var
899	REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
900	INTEGER, INTENT(IN), OPTIONAL :: ncols ! ug RUSTINE POUR LES Champs 4D.....
901	INTEGER, DIMENSION(3), INTENT(IN) :: nverts
902
903	INTEGER :: iff, k
904
905	REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
906	REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
907	INTEGER :: ip, n, nlev
908	INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
909	CHARACTER(LEN=20) :: nomi, nom
910	character(len=2) :: str2
911	LOGICAL, SAVE :: firstx
912	!$OMP THREADPRIVATE(firstx)
913
914	IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d ',var%name
915
916	! ug RUSTINE POUR LES STD LEVS.....
917	IF (PRESENT(ncols)) THEN
918	write(str2,'(i2.2)')ncols
919	nomi=var%name
920	nom="c"//str2//"_"//nomi
921	ELSE
922	nom=var%name
923	END IF
924	! On regarde si on est dans la phase de définition ou d'écriture:
925	IF(.NOT.cosp_varsdefined) THEN
926	!Si phase de définition.... on définit
927	!$OMP MASTER
928	CALL conf_cospoutputs(var%name,var%cles)
929	DO iff=1, 3
930	IF (cosp_outfilekeys(iff)) THEN
931	CALL histdef3d_cosp(iff, var, nverts(iff), ncols)
932	ENDIF
933	ENDDO
934	!$OMP END MASTER
935	ELSE
936	!Et sinon on.... écrit
937	IF (SIZE(field,1)/=klon) &
938	CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
939	nlev=SIZE(field,2)
940
941
942	CALL Gather_omp(field,buffer_omp)
943	!$OMP MASTER
944	CALL grid1Dto2D_mpi(buffer_omp,field3d)
945
946	! BOUCLE SUR LES FICHIERS
947	firstx=.true.
948	DO iff=1, 3
949	IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
950	ALLOCATE(index3d(nbp_lonjj_nbnlev))
951
952	IF (.not. ok_all_xml) then
953	IF (firstx) THEN
954	CALL xios_send_field(nom, Field3d(:,:,1:nlev))
955	IF (prt_level >= 9) WRITE(lunout,*)'xios_send_field ',var%name
956	firstx=.FALSE.
957	ENDIF
958	ENDIF
959	deallocate(index3d)
960	ENDIF
961	ENDDO
962	IF (ok_all_xml) THEN
963	CALL xios_send_field(nom, Field3d(:,:,1:nlev))
964	IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
965	ENDIF
966
967	!$OMP END MASTER
968	ENDIF ! vars_defined
969	IF (prt_level >= 9) write(lunout,*)'End histrwrite3d_cosp ',nom
970	END SUBROUTINE histwrite3d_cosp
971
972
973	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
974	! AI sept 2013
975	SUBROUTINE histwrite4d_cosp(var, field)
976	USE clesphys_mod_h
977	USE dimphy
978	USE mod_phys_lmdz_para
979	USE ioipsl
980	use iophy
981	USE mod_grid_phy_lmdz, ONLY: nbp_lon
982	USE print_control_mod, ONLY: lunout,prt_level
983
984	USE lmdz_xios, only: xios_send_field
985
986
987	IMPLICIT NONE
988
989	TYPE(ctrl_outcosp), INTENT(IN) :: var
990	REAL, DIMENSION(:,:,:), INTENT(IN) :: field ! --> field(klon,:)
991
992	INTEGER :: iff, k
993
994	REAL,DIMENSION(klon_mpi,SIZE(field,2),SIZE(field,3)) :: buffer_omp
995	REAL :: field4d(nbp_lon,jj_nb,SIZE(field,2),SIZE(field,3))
996	INTEGER :: ip, n, nlev, nlev2
997	INTEGER, ALLOCATABLE, DIMENSION(:) :: index4d
998	CHARACTER(LEN=20) :: nomi, nom
999
1000	IF (prt_level >= 9) write(lunout,*)'Begin histrwrite4d ',var%name
1001
1002	IF(cosp_varsdefined) THEN
1003	!Et sinon on.... écrit
1004	IF (SIZE(field,1)/=klon) &
1005	CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
1006
1007	nlev=SIZE(field,2)
1008	nlev2=SIZE(field,3)
1009	CALL Gather_omp(field,buffer_omp)
1010	!$OMP MASTER
1011	CALL grid1Dto2D_mpi(buffer_omp,field4d)
1012
1013	! IF (ok_all_xml) THEN
1014	CALL xios_send_field(var%name, Field4d(:,:,1:nlev,1:nlev2))
1015	IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
1016	! ENDIF
1017
1018	!$OMP END MASTER
1019	ENDIF ! vars_defined
1020	IF (prt_level >= 9) write(lunout,*)'End histrwrite4d_cosp ',nom
1021	END SUBROUTINE histwrite4d_cosp
1022
1023	SUBROUTINE conf_cospoutputs(nam_var,cles_var)
1024	!!! Lecture des noms et cles de sortie des variables dans config.def
1025	! en utilisant les routines getin de IOIPSL
1026	use ioipsl
1027	USE print_control_mod, ONLY: lunout,prt_level
1028
1029	IMPLICIT NONE
1030
1031	CHARACTER(LEN=20) :: nam_var, nnam_var
1032	LOGICAL, DIMENSION(3) :: cles_var
1033
1034	! Lecture dans config.def ou output.def de cles_var et name_var
1035	CALL getin('cles_'//nam_var,cles_var)
1036	CALL getin('name_'//nam_var,nam_var)
1037	IF(prt_level>10) WRITE(lunout,*)'nam_var cles_var ',nam_var,cles_var(:)
1038
1039	END SUBROUTINE conf_cospoutputs
1040
1041	END MODULE lmdz_cosp_output_write_mod

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

Download in other formats:

Original Format