Context Navigation

cosp_output_write_mod.F90 @ 5434

Last change on this file since 5434 was 5316, checked in by abarral, 7 weeks ago
Fix clesphys import for cosp
File size: 31.2 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	MODULE cosp_output_write_mod
5
6	USE cosp_output_mod
7
8	IMPLICIT NONE
9
10	INTEGER, SAVE :: itau_iocosp
11	!$OMP THREADPRIVATE(itau_iocosp)
12	INTEGER, save :: Nlevout, Ncolout
13	!$OMP THREADPRIVATE(Nlevout, Ncolout)
14
15	! INTERFACE histwrite_cosp
16	! MODULE PROCEDURE histwrite2d_cosp,histwrite3d_cosp
17	! END INTERFACE
18
19	CONTAINS
20
21	SUBROUTINE cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, missing_cosp, &
22	cfg, gbx, vgrid, sglidar, sgradar, stlidar, stradar, &
23	isccp, misr, modis)
24
25	USE ioipsl
26	USE time_phylmdz_mod, ONLY: itau_phy, start_time, day_step_phy
27	USE print_control_mod, ONLY: lunout,prt_level
28	use wxios_mod, only: wxios_closedef
29	USE lmdz_xios, only: xios_update_calendar, xios_field_is_active, using_xios
30	IMPLICIT NONE
31	!!! Variables d'entree
32	integer :: itap, Nlevlmdz, Ncolumns, Npoints
33	real :: freq_COSP, dtime, missing_val, missing_cosp
34	type(cosp_config) :: cfg ! Control outputs
35	type(cosp_gridbox) :: gbx ! Gridbox information. Input for COSP
36	type(cosp_sglidar) :: sglidar ! Output from lidar simulator
37	type(cosp_sgradar) :: sgradar ! Output from radar simulator
38	type(cosp_isccp) :: isccp ! Output from ISCCP simulator
39	type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator
40	type(cosp_radarstats) :: stradar
41	type(cosp_misr) :: misr ! Output from MISR
42	type(cosp_modis) :: modis ! Outputs from Modis
43	type(cosp_vgrid) :: vgrid ! Information on vertical grid of stats
44
45	!!! Variables locales
46	integer :: icl,k,ip
47	logical :: ok_sync
48	integer :: itau_wcosp, iff
49	real, dimension(Npoints,PARASOL_NREFL) :: parasolcrefl, Ncref
50
51	! Variables locals intermidiaires pour inverser les axes des champs 4D
52	! Compatibilite avec sorties CMIP
53	real, dimension(Npoints,Nlevout,SR_BINS) :: tmp_fi4da_cfadL
54	real, dimension(Npoints,Nlevout,DBZE_BINS) :: tmp_fi4da_cfadR
55	real, dimension(Npoints,MISR_N_CTH,7) :: tmp_fi4da_misr
56
57	IF (using_xios) THEN
58	missing_val=missing_cosp
59	ELSE
60	missing_val=0.
61	ENDIF
62
63	Nlevout = vgrid%Nlvgrid
64	Ncolout = Ncolumns
65
66	! A refaire
67	itau_wcosp = itau_phy + itap + start_time * day_step_phy
68	if (prt_level >= 10) then
69	WRITE(lunout,*)'itau_wcosp, itap, start_time, day_step_phy =', &
70	itau_wcosp, itap, start_time, day_step_phy
71	endif
72
73	! On le donne a cosp_output_write_mod pour que les histwrite y aient acces:
74	CALL set_itau_iocosp(itau_wcosp)
75	if (prt_level >= 10) then
76	WRITE(lunout,*)'itau_iocosp =',itau_iocosp
77	endif
78
79	ok_sync = .TRUE.
80
81	!DO iinit=1, iinitend
82	! AI sept 2014 cette boucle supprimee
83	! On n'ecrit pas quand itap=1 (cosp)
84
85	! if (prt_level >= 10) then
86	! WRITE(lunout,*)'DO iinit=1, iinitend ',iinitend
87	! endif
88
89	!!IF (using_xios) THEN
90	! !$OMP MASTER
91	!IF (cosp_varsdefined) THEN
92	! if (prt_level >= 10) then
93	! WRITE(lunout,*)'Apell xios_update_calendar cosp_varsdefined iinitend ', &
94	! cosp_varsdefined,iinitend
95	! endif
96	! CALL xios_update_calendar(itau_wcosp)
97	!ENDIF
98	! !$OMP END MASTER
99	! !$OMP BARRIER
100	!!ENDIF
101
102	!!!! Sorties Calipso
103	if (cfg%Llidar_sim) then
104	!!! AI 02 2018
105	! Traitement missing_val
106	where(stlidar%lidarcld == R_UNDEF) stlidar%lidarcld = missing_val
107	where(stlidar%proftemp == R_UNDEF) stlidar%proftemp = missing_val !TIBO
108	where(stlidar%profSR == R_UNDEF) stlidar%profSR = missing_val !TIBO2
109	where(sglidar%beta_mol == R_UNDEF) sglidar%beta_mol = missing_val
110	where(sglidar%beta_tot == R_UNDEF) sglidar%beta_tot = missing_val
111	where(stlidar%cldlayer == R_UNDEF) stlidar%cldlayer = missing_val
112	where(stlidar%cldtype == R_UNDEF) stlidar%cldtype = missing_val !OPAQ
113	where(stlidar%cfad_sr == R_UNDEF) stlidar%cfad_sr = missing_val
114	! AI 11 / 2015
115	where(stlidar%parasolrefl == R_UNDEF) stlidar%parasolrefl = missing_val
116	where(stlidar%lidarcldtmp == R_UNDEF) stlidar%lidarcldtmp = missing_val
117	where(stlidar%cldlayerphase == R_UNDEF) stlidar%cldlayerphase = missing_val
118	where(stlidar%lidarcldphase == R_UNDEF) stlidar%lidarcldphase = missing_val
119	where(stlidar%lidarcldtype == R_UNDEF) stlidar%lidarcldtype = missing_val !OPAQ
120	where(stlidar%lidarcldtmp == R_UNDEF) stlidar%lidarcldtmp = missing_val
121
122	! print*,'Appel histwrite2d_cosp'
123	if (cfg%Lcllcalipso) CALL histwrite2d_cosp(o_cllcalipso,stlidar%cldlayer(:,1))
124	if (cfg%Lclhcalipso) CALL histwrite2d_cosp(o_clhcalipso,stlidar%cldlayer(:,3))
125	if (cfg%Lclmcalipso) CALL histwrite2d_cosp(o_clmcalipso,stlidar%cldlayer(:,2))
126	if (cfg%Lcltcalipso) CALL histwrite2d_cosp(o_cltcalipso,stlidar%cldlayer(:,4))
127	if (cfg%Lclcalipso) CALL histwrite3d_cosp(o_clcalipso,stlidar%lidarcld,nvert)
128	if (cfg%Lclcalipsotmp) CALL histwrite3d_cosp(o_clcalipsotmp,stlidar%lidarcldtmp(:,:,1),nverttemp)
129
130	if (cfg%Lcllcalipsoice) CALL histwrite2d_cosp(o_cllcalipsoice,stlidar%cldlayerphase(:,1,1))
131	if (cfg%Lclhcalipsoice) CALL histwrite2d_cosp(o_clhcalipsoice,stlidar%cldlayerphase(:,3,1))
132	if (cfg%Lclmcalipsoice) CALL histwrite2d_cosp(o_clmcalipsoice,stlidar%cldlayerphase(:,2,1))
133	if (cfg%Lcltcalipsoice) CALL histwrite2d_cosp(o_cltcalipsoice,stlidar%cldlayerphase(:,4,1))
134	if (cfg%Lclcalipsoice) CALL histwrite3d_cosp(o_clcalipsoice,stlidar%lidarcldphase(:,:,1),nvert)
135	if (cfg%Lclcalipsotmpice) CALL histwrite3d_cosp(o_clcalipsotmpice,stlidar%lidarcldtmp(:,:,2),nverttemp)
136
137	if (cfg%Lcllcalipsoliq) CALL histwrite2d_cosp(o_cllcalipsoliq,stlidar%cldlayerphase(:,1,2))
138	if (cfg%Lclhcalipsoliq) CALL histwrite2d_cosp(o_clhcalipsoliq,stlidar%cldlayerphase(:,3,2))
139	if (cfg%Lclmcalipsoliq) CALL histwrite2d_cosp(o_clmcalipsoliq,stlidar%cldlayerphase(:,2,2))
140	if (cfg%Lcltcalipsoliq) CALL histwrite2d_cosp(o_cltcalipsoliq,stlidar%cldlayerphase(:,4,2))
141	if (cfg%Lclcalipsoliq) CALL histwrite3d_cosp(o_clcalipsoliq,stlidar%lidarcldphase(:,:,2),nvert)
142	if (cfg%Lclcalipsotmpliq) CALL histwrite3d_cosp(o_clcalipsotmpliq,stlidar%lidarcldtmp(:,:,3),nverttemp)
143
144	if (cfg%Lcllcalipsoun) CALL histwrite2d_cosp(o_cllcalipsoun,stlidar%cldlayerphase(:,1,3))
145	if (cfg%Lclhcalipsoun) CALL histwrite2d_cosp(o_clhcalipsoun,stlidar%cldlayerphase(:,3,3))
146	if (cfg%Lclmcalipsoun) CALL histwrite2d_cosp(o_clmcalipsoun,stlidar%cldlayerphase(:,2,3))
147	if (cfg%Lcltcalipsoun) CALL histwrite2d_cosp(o_cltcalipsoun,stlidar%cldlayerphase(:,4,3))
148	if (cfg%Lclcalipsoun) CALL histwrite3d_cosp(o_clcalipsoun,stlidar%lidarcldphase(:,:,3),nvert)
149	if (cfg%Lclcalipsotmpun) CALL histwrite3d_cosp(o_clcalipsotmpun,stlidar%lidarcldtmp(:,:,4),nverttemp)
150
151	if (cfg%Lclopaquecalipso) CALL histwrite2d_cosp(o_clopaquecalipso,stlidar%cldtype(:,1)) !OPAQ
152	if (cfg%Lclthincalipso) CALL histwrite2d_cosp(o_clthincalipso,stlidar%cldtype(:,2)) !OPAQ
153	if (cfg%Lclzopaquecalipso) CALL histwrite2d_cosp(o_clzopaquecalipso,stlidar%cldtype(:,3)) !OPAQ
154
155	if (cfg%Lclcalipsoopaque) CALL histwrite3d_cosp(o_clcalipsoopaque,stlidar%lidarcldtype(:,:,1),nvert) !OPAQ
156	if (cfg%Lclcalipsothin) CALL histwrite3d_cosp(o_clcalipsothin,stlidar%lidarcldtype(:,:,2),nvert) !OPAQ
157	if (cfg%Lclcalipsozopaque) CALL histwrite3d_cosp(o_clcalipsozopaque,stlidar%lidarcldtype(:,:,3),nvert) !OPAQ
158	if (cfg%Lclcalipsoopacity) CALL histwrite3d_cosp(o_clcalipsoopacity,stlidar%lidarcldtype(:,:,4),nvert) !OPAQ
159
160	if (cfg%Lproftemp) CALL histwrite3d_cosp(o_proftemp,stlidar%proftemp,nvert) !TIBO
161
162	IF (using_xios) THEN
163	do icl=1,SR_BINS
164	tmp_fi4da_cfadL(:,:,icl)=stlidar%cfad_sr(:,icl,:)
165	enddo
166	! if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr)
167	if (cfg%LcfadLidarsr532) CALL histwrite4d_cosp(o_cfad_lidarsr532,tmp_fi4da_cfadL)
168	if (cfg%LprofSR) CALL histwrite4d_cosp(o_profSR,stlidar%profSR) !TIBO
169	ELSE
170	if (cfg%LcfadLidarsr532) then
171	do icl=1,SR_BINS
172	CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
173	enddo
174	endif
175	if (cfg%LprofSR) then
176	do icl=1,Ncolumns !TIBO
177	CALL histwrite3d_cosp(o_profSR,stlidar%profSR(:,icl,:),nvert,icl) !TIBO
178	enddo !TIBO
179	endif
180	ENDIF
181
182	if (cfg%LparasolRefl) CALL histwrite3d_cosp(o_parasol_refl,stlidar%parasolrefl,nvertp)
183
184	if (cfg%LparasolRefl) then
185	do k=1,PARASOL_NREFL
186	do ip=1, Npoints
187	if (stlidar%cldlayer(ip,4).gt.0.01.and.stlidar%parasolrefl(ip,k).ne.missing_val) then
188	parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)))/ &
189	stlidar%cldlayer(ip,4)
190	Ncref(ip,k) = 1.
191	else
192	parasolcrefl(ip,k)=missing_val
193	Ncref(ip,k) = 0.
194	endif
195	enddo
196	enddo
197	CALL histwrite3d_cosp(o_Ncrefl,Ncref,nvertp)
198	CALL histwrite3d_cosp(o_parasol_crefl,parasolcrefl,nvertp)
199	endif
200
201	IF (using_xios) THEN
202	if (cfg%Latb532) CALL histwrite4d_cosp(o_atb532,sglidar%beta_tot)
203	ELSE
204	if (cfg%Latb532) then
205	do icl=1,Ncolumns
206	CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
207	enddo
208	endif
209	ENDIF
210
211	if (cfg%LlidarBetaMol532) CALL histwrite3d_cosp(o_beta_mol532,sglidar%beta_mol,nvertmcosp)
212
213	endif !Lidar
214
215	!!! Sorties Cloudsat
216	if (cfg%Lradar_sim) then
217
218	where(stradar%cfad_ze == R_UNDEF) stradar%cfad_ze = missing_val
219	IF (using_xios) THEN
220	do icl=1,DBZE_BINS
221	tmp_fi4da_cfadR(:,:,icl)=stradar%cfad_ze(:,icl,:)
222	enddo
223	if (cfg%Ldbze94) CALL histwrite4d_cosp(o_dbze94,sgradar%Ze_tot)
224	! if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,stradar%cfad_ze)
225	if (cfg%LcfadDbze94) CALL histwrite4d_cosp(o_cfadDbze94,tmp_fi4da_cfadR)
226	ELSE
227	if (cfg%Ldbze94) then
228	do icl=1,Ncolumns
229	CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvert,icl)
230	enddo
231	endif
232	if (cfg%LcfadDbze94) then
233	do icl=1,DBZE_BINS
234	CALL histwrite3d_cosp(o_cfadDbze94,stradar%cfad_ze(:,icl,:),nvert,icl)
235	enddo
236	endif
237	ENDIF
238	endif
239	! endif pour radar
240
241	!!! Sorties combinees Cloudsat et Calipso
242	if (cfg%Llidar_sim .and. cfg%Lradar_sim) then
243	where(stradar%lidar_only_freq_cloud == R_UNDEF) &
244	stradar%lidar_only_freq_cloud = missing_val
245	if (cfg%Lclcalipso) CALL histwrite3d_cosp(o_clcalipso2,stradar%lidar_only_freq_cloud,nvert)
246	where(stradar%radar_lidar_tcc == R_UNDEF) &
247	stradar%radar_lidar_tcc = missing_val
248	if (cfg%Lcltlidarradar) CALL histwrite2d_cosp(o_cltlidarradar,stradar%radar_lidar_tcc)
249	endif
250
251	!!! Sorties Isccp
252	if (cfg%Lisccp_sim) then
253	where(isccp%totalcldarea == R_UNDEF) isccp%totalcldarea = missing_val
254	where(isccp%meanptop == R_UNDEF) isccp%meanptop = missing_val
255	where(isccp%meantaucld == R_UNDEF) isccp%meantaucld = missing_val
256	where(isccp%meanalbedocld == R_UNDEF) isccp%meanalbedocld = missing_val
257	where(isccp%meantb == R_UNDEF) isccp%meantb = missing_val
258	where(isccp%meantbclr == R_UNDEF) isccp%meantbclr = missing_val
259	where(isccp%fq_isccp == R_UNDEF) isccp%fq_isccp = missing_val
260	where(isccp%boxtau == R_UNDEF) isccp%boxtau = missing_val
261	where(isccp%boxptop == R_UNDEF) isccp%boxptop = missing_val
262
263	CALL histwrite2d_cosp(o_sunlit,gbx%sunlit)
264	IF (using_xios) THEN
265	if (cfg%Lclisccp) CALL histwrite4d_cosp(o_clisccp2,isccp%fq_isccp)
266	ELSE
267	if (cfg%Lclisccp) then
268	do icl=1,7
269	CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl)
270	enddo
271	endif
272	ENDIF
273
274	if (cfg%Lboxtauisccp) CALL histwrite3d_cosp(o_boxtauisccp,isccp%boxtau,nvertcol)
275	if (cfg%Lboxptopisccp) CALL histwrite3d_cosp(o_boxptopisccp,isccp%boxptop,nvertcol)
276	if (cfg%Lcltisccp) CALL histwrite2d_cosp(o_tclisccp,isccp%totalcldarea)
277	if (cfg%Lpctisccp) CALL histwrite2d_cosp(o_ctpisccp,isccp%meanptop)
278	if (cfg%Ltauisccp) CALL histwrite2d_cosp(o_tauisccp,isccp%meantaucld)
279	if (cfg%Lalbisccp) CALL histwrite2d_cosp(o_albisccp,isccp%meanalbedocld)
280	if (cfg%Lmeantbisccp) CALL histwrite2d_cosp(o_meantbisccp,isccp%meantb)
281	if (cfg%Lmeantbclrisccp) CALL histwrite2d_cosp(o_meantbclrisccp,isccp%meantbclr)
282	endif ! Isccp
283
284	!!! MISR simulator
285	if (cfg%Lmisr_sim) then
286	where(misr%fq_MISR == R_UNDEF) misr%fq_MISR = missing_val
287
288	IF (using_xios) THEN
289	do icl=1,MISR_N_CTH
290	tmp_fi4da_misr(:,icl,:)=misr%fq_MISR(:,:,icl)
291	enddo
292	! if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,misr%fq_MISR)
293	if (cfg%LclMISR) CALL histwrite4d_cosp(o_clMISR,tmp_fi4da_misr)
294	ELSE
295	if (cfg%LclMISR) then
296	do icl=1,7
297	CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
298	enddo
299	endif
300	ENDIF
301	endif
302	! endif pour Misr
303
304	!!! Modis simulator
305	if (cfg%Lmodis_sim) then
306	where(modis%Cloud_Fraction_Low_Mean == R_UNDEF) &
307	modis%Cloud_Fraction_Low_Mean = missing_val
308	where(modis%Cloud_Fraction_High_Mean == R_UNDEF) &
309	modis%Cloud_Fraction_High_Mean = missing_val
310	where(modis%Cloud_Fraction_Mid_Mean == R_UNDEF) &
311	modis%Cloud_Fraction_Mid_Mean = missing_val
312	where(modis%Cloud_Fraction_Total_Mean == R_UNDEF) &
313	modis%Cloud_Fraction_Total_Mean = missing_val
314	where(modis%Cloud_Fraction_Water_Mean == R_UNDEF) &
315	modis%Cloud_Fraction_Water_Mean = missing_val
316	where(modis%Cloud_Fraction_Ice_Mean == R_UNDEF) &
317	modis%Cloud_Fraction_Ice_Mean = missing_val
318	where(modis%Optical_Thickness_Total_Mean == R_UNDEF) &
319	modis%Optical_Thickness_Total_Mean = missing_val
320	where(modis%Optical_Thickness_Water_Mean == R_UNDEF) &
321	modis%Optical_Thickness_Water_Mean = missing_val
322	where(modis%Optical_Thickness_Ice_Mean == R_UNDEF) &
323	modis%Optical_Thickness_Ice_Mean = missing_val
324	where(modis%Cloud_Particle_Size_Water_Mean == R_UNDEF) &
325	modis%Cloud_Particle_Size_Water_Mean = missing_val
326	where(modis%Cloud_Particle_Size_Ice_Mean == R_UNDEF) &
327	modis%Cloud_Particle_Size_Ice_Mean = missing_val
328	where(modis%Cloud_Top_Pressure_Total_Mean == R_UNDEF) &
329	modis%Cloud_Top_Pressure_Total_Mean = missing_val
330	where(modis%Liquid_Water_Path_Mean == R_UNDEF) &
331	modis%Liquid_Water_Path_Mean = missing_val
332	where(modis%Ice_Water_Path_Mean == R_UNDEF) &
333	modis%Ice_Water_Path_Mean = missing_val
334
335	where(modis%Optical_Thickness_Total_LogMean == R_UNDEF) &
336	modis%Optical_Thickness_Total_LogMean = missing_val
337
338	where(modis%Optical_Thickness_Water_LogMean == R_UNDEF) &
339	modis%Optical_Thickness_Water_LogMean = missing_val
340
341	where(modis%Optical_Thickness_Ice_LogMean == R_UNDEF) &
342	modis%Optical_Thickness_Ice_LogMean = missing_val
343
344	if (cfg%Lcllmodis) CALL histwrite2d_cosp(o_cllmodis,modis%Cloud_Fraction_Low_Mean)
345	if (cfg%Lclhmodis) CALL histwrite2d_cosp(o_clhmodis,modis%Cloud_Fraction_High_Mean)
346	if (cfg%Lclmmodis) CALL histwrite2d_cosp(o_clmmodis,modis%Cloud_Fraction_Mid_Mean)
347	if (cfg%Lcltmodis) CALL histwrite2d_cosp(o_cltmodis,modis%Cloud_Fraction_Total_Mean)
348	if (cfg%Lclwmodis) CALL histwrite2d_cosp(o_clwmodis,modis%Cloud_Fraction_Water_Mean)
349	if (cfg%Lclimodis) CALL histwrite2d_cosp(o_climodis,modis%Cloud_Fraction_Ice_Mean)
350	if (cfg%Ltautmodis) CALL histwrite2d_cosp(o_tautmodis,modis%Optical_Thickness_Total_Mean)
351	if (cfg%Ltauwmodis) CALL histwrite2d_cosp(o_tauwmodis,modis%Optical_Thickness_Water_Mean)
352	if (cfg%Ltauimodis) CALL histwrite2d_cosp(o_tauimodis,modis%Optical_Thickness_Ice_Mean)
353	if (cfg%Ltautlogmodis) CALL histwrite2d_cosp(o_tautlogmodis,modis%Optical_Thickness_Total_LogMean)
354	if (cfg%Ltauwlogmodis) CALL histwrite2d_cosp(o_tauwlogmodis,modis%Optical_Thickness_Water_LogMean)
355	if (cfg%Ltauilogmodis) CALL histwrite2d_cosp(o_tauilogmodis,modis%Optical_Thickness_Ice_LogMean)
356	if (cfg%Lreffclwmodis) CALL histwrite2d_cosp(o_reffclwmodis,modis%Cloud_Particle_Size_Water_Mean)
357	if (cfg%Lreffclimodis) CALL histwrite2d_cosp(o_reffclimodis,modis%Cloud_Particle_Size_Ice_Mean)
358	if (cfg%Lpctmodis) CALL histwrite2d_cosp(o_pctmodis,modis%Cloud_Top_Pressure_Total_Mean)
359	if (cfg%Llwpmodis) CALL histwrite2d_cosp(o_lwpmodis,modis%Liquid_Water_Path_Mean)
360	if (cfg%Liwpmodis) CALL histwrite2d_cosp(o_iwpmodis,modis%Ice_Water_Path_Mean)
361
362	where(modis%Optical_Thickness_vs_Cloud_Top_Pressure == R_UNDEF) &
363	modis%Optical_Thickness_vs_Cloud_Top_Pressure = missing_val
364
365	IF (using_xios) THEN
366	if (cfg%Lclmodis) CALL histwrite4d_cosp(o_clmodis,modis%Optical_Thickness_vs_Cloud_Top_Pressure)
367	ELSE
368	if (cfg%Lclmodis) then
369	do icl=1,7
370	CALL histwrite3d_cosp(o_clmodis, &
371	modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)
372	enddo
373	endif
374	ENDIF
375
376	where(modis%Optical_Thickness_vs_ReffIce == R_UNDEF) &
377	modis%Optical_Thickness_vs_ReffIce = missing_val
378
379	where(modis%Optical_Thickness_vs_ReffLiq == R_UNDEF) &
380	modis%Optical_Thickness_vs_ReffLiq = missing_val
381
382	IF (using_xios) THEN
383	if (cfg%Lcrimodis) CALL histwrite4d_cosp(o_crimodis,modis%Optical_Thickness_vs_ReffIce)
384	if (cfg%Lcrlmodis) CALL histwrite4d_cosp(o_crlmodis,modis%Optical_Thickness_vs_ReffLiq)
385	ELSE
386	if (cfg%Lcrimodis) then
387	do icl=1,7
388	CALL histwrite3d_cosp(o_crimodis, &
389	modis%Optical_Thickness_vs_ReffIce(:,icl,:),nvertReffIce,icl)
390	enddo
391	endif
392	if (cfg%Lcrlmodis) then
393	do icl=1,7
394	CALL histwrite3d_cosp(o_crlmodis, &
395	modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)
396	enddo
397	endif
398	ENDIF
399	endif !modis
400
401	IF(.NOT.cosp_varsdefined) THEN
402	!$OMP MASTER
403	#ifndef CPP_IOIPSL_NO_OUTPUT
404	DO iff=1,3
405	IF (cosp_outfilekeys(iff)) THEN
406	CALL histend(cosp_nidfiles(iff))
407	ENDIF ! cosp_outfilekeys
408	ENDDO ! iff
409	#endif
410
411	!$OMP END MASTER
412	!$OMP BARRIER
413	cosp_varsdefined = .TRUE.
414	END IF
415
416	IF(cosp_varsdefined) THEN
417	! On synchronise les fichiers pour IOIPSL
418	#ifndef CPP_IOIPSL_NO_OUTPUT
419	!$OMP MASTER
420	DO iff=1,3
421	IF (ok_sync .AND. cosp_outfilekeys(iff)) THEN
422	CALL histsync(cosp_nidfiles(iff))
423	ENDIF
424	END DO
425	!$OMP END MASTER
426	#endif
427	ENDIF !cosp_varsdefined
428
429	END SUBROUTINE cosp_output_write
430
431	! ug Routine pour definir itau_iocosp depuis cosp_output_write_mod:
432	SUBROUTINE set_itau_iocosp(ito)
433	USE clesphys_mod_h
434	IMPLICIT NONE
435	INTEGER, INTENT(IN) :: ito
436	itau_iocosp = ito
437	END SUBROUTINE
438
439	SUBROUTINE histdef2d_cosp (iff,var)
440
441	USE ioipsl
442	USE dimphy
443	use iophy
444	USE mod_phys_lmdz_para
445	USE mod_grid_phy_lmdz, ONLY: nbp_lon
446	USE print_control_mod, ONLY: lunout,prt_level
447	use wxios_mod
448	USE clesphys_mod_h, ONLY: ok_all_xml
449
450	IMPLICIT NONE
451
452
453	INTEGER :: iff
454	TYPE(ctrl_outcosp) :: var
455
456	REAL zstophym
457	CHARACTER(LEN=20) :: typeecrit
458
459	! ug On récupère le type écrit de la structure:
460	! Assez moche, �\| refaire si meilleure méthode...
461	IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
462	typeecrit = 'once'
463	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
464	typeecrit = 't_min(X)'
465	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
466	typeecrit = 't_max(X)'
467	ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
468	typeecrit = 'inst(X)'
469	ELSE
470	typeecrit = cosp_outfiletypes(iff)
471	ENDIF
472
473	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
474	zstophym=zoutm_cosp(iff)
475	ELSE
476	zstophym=zdtimemoy_cosp
477	ENDIF
478
479	IF (using_xios) THEN
480	IF (.not. ok_all_xml) then
481	IF ( var%cles(iff) ) THEN
482	if (prt_level >= 10) then
483	WRITE(lunout,*)'Appel wxios_add_field_to_file var%name =',var%name
484	endif
485	CALL wxios_add_field_to_file(var%name, 2, cosp_nidfiles(iff), cosp_outfilenames(iff), &
486	var%description, var%unit, 1, typeecrit)
487	ENDIF
488	ENDIF
489	ENDIF
490
491	#ifndef CPP_IOIPSL_NO_OUTPUT
492	IF ( var%cles(iff) ) THEN
493	CALL histdef (cosp_nidfiles(iff), var%name, var%description, var%unit, &
494	nbp_lon,jj_nb,nhoricosp(iff), 1,1,1, -99, 32, &
495	typeecrit, zstophym,zoutm_cosp(iff))
496	ENDIF
497	#endif
498
499	END SUBROUTINE histdef2d_cosp
500
501	SUBROUTINE histdef3d_cosp (iff,var,nvertsave,ncols)
502	USE clesphys_mod_h
503	USE ioipsl
504	USE dimphy
505	use iophy
506	USE mod_phys_lmdz_para
507	USE mod_grid_phy_lmdz, ONLY: nbp_lon
508	USE print_control_mod, ONLY: lunout,prt_level
509	use wxios_mod
510	USE clesphys_mod_h, ONLY: ok_all_xml
511
512	IMPLICIT NONE
513
514
515	INTEGER :: iff, klevs
516	INTEGER, INTENT(IN), OPTIONAL :: ncols ! ug RUSTINE POUR LES variables 4D
517	INTEGER, INTENT(IN) :: nvertsave
518	TYPE(ctrl_outcosp) :: var
519
520	REAL zstophym
521	CHARACTER(LEN=20) :: typeecrit, nomi
522	CHARACTER(LEN=20) :: nom
523	character(len=2) :: str2
524	CHARACTER(len=20) :: nam_axvert
525
526	! Axe vertical
527	IF (nvertsave.eq.nvertp(iff)) THEN
528	klevs=PARASOL_NREFL
529	nam_axvert="sza"
530	ELSE IF (nvertsave.eq.nvertisccp(iff)) THEN
531	klevs=7
532	nam_axvert="pressure2"
533	ELSE IF (nvertsave.eq.nvertcol(iff)) THEN
534	klevs=Ncolout
535	nam_axvert="column"
536	ELSE IF (nvertsave.eq.nverttemp(iff)) THEN
537	klevs=LIDAR_NTEMP
538	nam_axvert="temp"
539	ELSE IF (nvertsave.eq.nvertmisr(iff)) THEN
540	klevs=MISR_N_CTH
541	nam_axvert="cth16"
542	ELSE IF (nvertsave.eq.nvertReffIce(iff)) THEN
543	klevs= numMODISReffIceBins
544	nam_axvert="ReffIce"
545	ELSE IF (nvertsave.eq.nvertReffLiq(iff)) THEN
546	klevs= numMODISReffLiqBins
547	nam_axvert="ReffLiq"
548	ELSE
549	klevs=Nlevout
550	nam_axvert="presnivs"
551	ENDIF
552
553	! ug RUSTINE POUR LES Champs 4D
554	IF (PRESENT(ncols)) THEN
555	write(str2,'(i2.2)')ncols
556	nomi=var%name
557	nom="c"//str2//"_"//nomi
558	ELSE
559	nom=var%name
560	END IF
561
562	! ug On récupère le type écrit de la structure:
563	! Assez moche, �\| refaire si meilleure méthode...
564	IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
565	typeecrit = 'once'
566	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
567	typeecrit = 't_min(X)'
568	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
569	typeecrit = 't_max(X)'
570	ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
571	typeecrit = 'inst(X)'
572	ELSE
573	typeecrit = cosp_outfiletypes(iff)
574	ENDIF
575
576	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
577	zstophym=zoutm_cosp(iff)
578	ELSE
579	zstophym=zdtimemoy_cosp
580	ENDIF
581
582	IF (using_xios) THEN
583	IF (.not. ok_all_xml) then
584	IF ( var%cles(iff) ) THEN
585	if (prt_level >= 10) then
586	WRITE(lunout,*)'Appel wxios_add_field_to_file 3d nom variable nam_axvert = ',nom, nam_axvert
587	endif
588	CALL wxios_add_field_to_file(nom, 3, cosp_nidfiles(iff), cosp_outfilenames(iff), &
589	var%description, var%unit, 1, typeecrit, nam_axvert)
590	ENDIF
591	ENDIF
592	ENDIF
593
594	#ifndef CPP_IOIPSL_NO_OUTPUT
595	IF ( var%cles(iff) ) THEN
596	CALL histdef (cosp_nidfiles(iff), nom, var%description, var%unit, &
597	nbp_lon, jj_nb, nhoricosp(iff), klevs, 1, &
598	klevs, nvertsave, 32, typeecrit, &
599	zstophym, zoutm_cosp(iff))
600	ENDIF
601	#endif
602
603	END SUBROUTINE histdef3d_cosp
604
605	SUBROUTINE histwrite2d_cosp(var,field)
606	USE clesphys_mod_h
607	USE dimphy
608	USE mod_phys_lmdz_para
609	USE ioipsl
610	use iophy
611	USE mod_grid_phy_lmdz, ONLY: nbp_lon
612	USE print_control_mod, ONLY: lunout,prt_level
613	USE lmdz_xios, only: xios_send_field, using_xios
614	USE clesphys_mod_h, ONLY: ok_all_xml
615
616	IMPLICIT NONE
617
618	TYPE(ctrl_outcosp), INTENT(IN) :: var
619	REAL, DIMENSION(:), INTENT(IN) :: field
620
621	INTEGER :: iff
622
623	REAL,DIMENSION(klon_mpi) :: buffer_omp
624	INTEGER, allocatable, DIMENSION(:) :: index2d
625	REAL :: Field2d(nbp_lon,jj_nb)
626	CHARACTER(LEN=20) :: nomi, nom
627	character(len=2) :: str2
628	LOGICAL, SAVE :: firstx
629	!$OMP THREADPRIVATE(firstx)
630
631	IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
632
633	! On regarde si on est dans la phase de définition ou d'écriture:
634	IF(.NOT.cosp_varsdefined) THEN
635	!$OMP MASTER
636	!Si phase de définition.... on définit
637	CALL conf_cospoutputs(var%name,var%cles)
638	DO iff=1, 3
639	IF (cosp_outfilekeys(iff)) THEN
640	CALL histdef2d_cosp(iff, var)
641	ENDIF
642	ENDDO
643	!$OMP END MASTER
644	ELSE
645	!Et sinon on.... écrit
646	IF (SIZE(field)/=klon) &
647	CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1)
648
649	CALL Gather_omp(field,buffer_omp)
650	!$OMP MASTER
651	CALL grid1Dto2D_mpi(buffer_omp,Field2d)
652
653	! La boucle sur les fichiers:
654	firstx=.true.
655	DO iff=1, 3
656	IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
657	ALLOCATE(index2d(nbp_lon*jj_nb))
658	#ifndef CPP_IOIPSL_NO_OUTPUT
659	CALL histwrite(cosp_nidfiles(iff),var%name,itau_iocosp,Field2d,nbp_lon*jj_nb,index2d)
660	#endif
661	deallocate(index2d)
662	IF (using_xios) THEN
663	IF (.not. ok_all_xml) then
664	if (firstx) then
665	if (prt_level >= 10) then
666	WRITE(lunout,*)'xios_send_field variable ',var%name
667	endif
668	CALL xios_send_field(var%name, Field2d)
669	firstx=.false.
670	endif
671	ENDIF
672	ENDIF
673	ENDIF
674	ENDDO
675
676	IF (using_xios) THEN
677	IF (ok_all_xml) THEN
678	if (prt_level >= 1) then
679	WRITE(lunout,*)'xios_send_field variable ',var%name
680	endif
681	CALL xios_send_field(var%name, Field2d)
682	ENDIF
683	ENDIF
684
685	!$OMP END MASTER
686	ENDIF ! vars_defined
687	IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_cosp ',var%name
688	END SUBROUTINE histwrite2d_cosp
689
690	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
691	! AI sept 2013
692	SUBROUTINE histwrite3d_cosp(var, field, nverts, ncols)
693	USE clesphys_mod_h
694	USE dimphy
695	USE mod_phys_lmdz_para
696	USE ioipsl
697	use iophy
698	USE mod_grid_phy_lmdz, ONLY: nbp_lon
699	USE print_control_mod, ONLY: lunout,prt_level
700	USE lmdz_xios, only: xios_send_field, using_xios
701	USE clesphys_mod_h, ONLY: ok_all_xml
702
703	IMPLICIT NONE
704
705	TYPE(ctrl_outcosp), INTENT(IN) :: var
706	REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
707	INTEGER, INTENT(IN), OPTIONAL :: ncols ! ug RUSTINE POUR LES Champs 4D.....
708	INTEGER, DIMENSION(3), INTENT(IN) :: nverts
709
710	INTEGER :: iff, k
711
712	REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
713	REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
714	INTEGER :: ip, n, nlev
715	INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
716	CHARACTER(LEN=20) :: nomi, nom
717	character(len=2) :: str2
718	LOGICAL, SAVE :: firstx
719	!$OMP THREADPRIVATE(firstx)
720
721	IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d ',var%name
722
723	! ug RUSTINE POUR LES STD LEVS.....
724	IF (PRESENT(ncols)) THEN
725	write(str2,'(i2.2)')ncols
726	nomi=var%name
727	nom="c"//str2//"_"//nomi
728	ELSE
729	nom=var%name
730	END IF
731	! On regarde si on est dans la phase de définition ou d'écriture:
732	IF(.NOT.cosp_varsdefined) THEN
733	!Si phase de définition.... on définit
734	!$OMP MASTER
735	CALL conf_cospoutputs(var%name,var%cles)
736	DO iff=1, 3
737	IF (cosp_outfilekeys(iff)) THEN
738	CALL histdef3d_cosp(iff, var, nverts(iff), ncols)
739	ENDIF
740	ENDDO
741	!$OMP END MASTER
742	ELSE
743	!Et sinon on.... écrit
744	IF (SIZE(field,1)/=klon) &
745	CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
746	nlev=SIZE(field,2)
747
748
749	CALL Gather_omp(field,buffer_omp)
750	!$OMP MASTER
751	CALL grid1Dto2D_mpi(buffer_omp,field3d)
752
753	! BOUCLE SUR LES FICHIERS
754	firstx=.true.
755	DO iff=1, 3
756	IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
757	ALLOCATE(index3d(nbp_lonjj_nbnlev))
758	#ifndef CPP_IOIPSL_NO_OUTPUT
759	CALL histwrite(cosp_nidfiles(iff),nom,itau_iocosp,Field3d,nbp_lonjj_nbnlev,index3d)
760	#endif
761
762	IF (using_xios) THEN
763	IF (.not. ok_all_xml) then
764	IF (firstx) THEN
765	CALL xios_send_field(nom, Field3d(:,:,1:nlev))
766	IF (prt_level >= 9) WRITE(lunout,*)'xios_send_field ',var%name
767	firstx=.FALSE.
768	ENDIF
769	ENDIF
770	ENDIF
771	deallocate(index3d)
772	ENDIF
773	ENDDO
774
775	IF (using_xios) THEN
776	IF (ok_all_xml) THEN
777	CALL xios_send_field(nom, Field3d(:,:,1:nlev))
778	IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
779	ENDIF
780	ENDIF
781
782	!$OMP END MASTER
783	ENDIF ! vars_defined
784	IF (prt_level >= 9) write(lunout,*)'End histrwrite3d_cosp ',nom
785	END SUBROUTINE histwrite3d_cosp
786
787	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
788	! AI sept 2013
789	SUBROUTINE histwrite4d_cosp(var, field)
790	USE clesphys_mod_h
791	USE dimphy
792	USE mod_phys_lmdz_para
793	USE ioipsl
794	use iophy
795	USE mod_grid_phy_lmdz, ONLY: nbp_lon
796	USE print_control_mod, ONLY: lunout,prt_level
797	USE lmdz_xios, only: xios_send_field, using_xios
798	USE clesphys_mod_h, ONLY: ok_all_xml
799
800	IMPLICIT NONE
801
802	TYPE(ctrl_outcosp), INTENT(IN) :: var
803	REAL, DIMENSION(:,:,:), INTENT(IN) :: field ! --> field(klon,:)
804
805	INTEGER :: iff, k
806
807	REAL,DIMENSION(klon_mpi,SIZE(field,2),SIZE(field,3)) :: buffer_omp
808	REAL :: field4d(nbp_lon,jj_nb,SIZE(field,2),SIZE(field,3))
809	INTEGER :: ip, n, nlev, nlev2
810	INTEGER, ALLOCATABLE, DIMENSION(:) :: index4d
811	CHARACTER(LEN=20) :: nomi, nom
812
813	IF (prt_level >= 9) write(lunout,*)'Begin histrwrite4d ',var%name
814
815	IF(cosp_varsdefined) THEN
816	!Et sinon on.... écrit
817	IF (SIZE(field,1)/=klon) &
818	CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
819
820	nlev=SIZE(field,2)
821	nlev2=SIZE(field,3)
822	CALL Gather_omp(field,buffer_omp)
823	!$OMP MASTER
824	CALL grid1Dto2D_mpi(buffer_omp,field4d)
825
826	IF (using_xios) THEN
827	! IF (ok_all_xml) THEN
828	CALL xios_send_field(var%name, Field4d(:,:,1:nlev,1:nlev2))
829	IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
830	! ENDIF
831	ENDIF
832
833	!$OMP END MASTER
834	ENDIF ! vars_defined
835	IF (prt_level >= 9) write(lunout,*)'End histrwrite4d_cosp ',nom
836	END SUBROUTINE histwrite4d_cosp
837
838	SUBROUTINE conf_cospoutputs(nam_var,cles_var)
839	!!! Lecture des noms et cles de sortie des variables dans config.def
840	! en utilisant les routines getin de IOIPSL
841	use ioipsl
842	USE print_control_mod, ONLY: lunout,prt_level
843
844	IMPLICIT NONE
845
846	CHARACTER(LEN=20) :: nam_var, nnam_var
847	LOGICAL, DIMENSION(3) :: cles_var
848
849	! Lecture dans config.def ou output.def de cles_var et name_var
850	CALL getin('cles_'//nam_var,cles_var)
851	CALL getin('name_'//nam_var,nam_var)
852	IF(prt_level>10) WRITE(lunout,*)'nam_var cles_var ',nam_var,cles_var(:)
853
854	END SUBROUTINE conf_cospoutputs
855
856	END MODULE cosp_output_write_mod

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

Download in other formats:

Original Format