source: LMDZ6/trunk/libf/phylmd/cospv2/lmdz_cosp_output_write_mod.F90 @ 4122

Last change on this file since 4122 was 3731, checked in by idelkadi, 4 years ago

Debugging COSP v2 for simulators Calipso, Parasol, Cloudsat
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, only: wxios_closedef
44    USE 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
328endif ! 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
376endif ! 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      IMPLICIT NONE
647      INTEGER, INTENT(IN) :: ito
648      itau_iocosp = ito
649  END SUBROUTINE
650
651  SUBROUTINE histdef2d_cosp (iff,var)
652
653    USE ioipsl
654    USE dimphy
655    use iophy
656    USE mod_phys_lmdz_para
657    USE mod_grid_phy_lmdz, ONLY: nbp_lon
658    USE print_control_mod, ONLY: lunout,prt_level
659  USE wxios
660
661    IMPLICIT NONE
662
663    INCLUDE "clesphys.h"
664
665    INTEGER                          :: iff
666    TYPE(ctrl_outcosp)               :: var
667
668    REAL zstophym
669    CHARACTER(LEN=20) :: typeecrit
670
671    ! ug On récupère le type écrit de la structure:
672    !       Assez moche, Ã|  refaire si meilleure méthode...
673    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
674       typeecrit = 'once'
675    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
676       typeecrit = 't_min(X)'
677    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
678       typeecrit = 't_max(X)'
679    ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
680       typeecrit = 'inst(X)'
681    ELSE
682       typeecrit = cosp_outfiletypes(iff)
683    ENDIF
684
685    IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
686       zstophym=zoutm_cosp(iff)
687    ELSE
688       zstophym=zdtimemoy_cosp
689    ENDIF
690
691     IF (.not. ok_all_xml) then
692       IF ( var%cles(iff) ) THEN
693         if (prt_level >= 10) then
694              WRITE(lunout,*)'Appel wxios_add_field_to_file var%name =',var%name
695         endif
696        CALL wxios_add_field_to_file(var%name, 2, cosp_nidfiles(iff), cosp_outfilenames(iff), &
697                                     var%description, var%unit, 1, typeecrit)
698       ENDIF
699     ENDIF
700
701
702  END SUBROUTINE histdef2d_cosp
703
704
705 SUBROUTINE histdef3d_cosp (iff,var,nvertsave,ncols)
706    USE ioipsl
707    USE dimphy
708    use iophy
709    USE mod_phys_lmdz_para
710    USE mod_grid_phy_lmdz, ONLY: nbp_lon
711    USE print_control_mod, ONLY: lunout,prt_level
712
713  USE wxios
714
715
716    IMPLICIT NONE
717
718    INCLUDE "clesphys.h"
719
720    INTEGER                        :: iff, klevs
721    INTEGER, INTENT(IN), OPTIONAL  :: ncols ! ug RUSTINE POUR LES variables 4D
722    INTEGER, INTENT(IN)           :: nvertsave
723    TYPE(ctrl_outcosp)             :: var
724
725    REAL zstophym
726    CHARACTER(LEN=20) :: typeecrit, nomi
727    CHARACTER(LEN=20) :: nom
728    character(len=2) :: str2
729    CHARACTER(len=20) :: nam_axvert
730
731! Axe vertical
732      IF (nvertsave.eq.nvertp(iff)) THEN
733          klevs=PARASOL_NREFL
734          nam_axvert="sza"
735      ELSE IF (nvertsave.eq.nvertisccp(iff)) THEN
736          klevs=7
737          nam_axvert="pressure2"
738      ELSE IF (nvertsave.eq.nvertcol(iff)) THEN
739          klevs=Ncolout
740          nam_axvert="column"
741      ELSE IF (nvertsave.eq.nverttemp(iff)) THEN
742          klevs=LIDAR_NTEMP
743          nam_axvert="temp"
744      ELSE IF (nvertsave.eq.nvertmisr(iff)) THEN
745          klevs=numMISRHgtBins
746          nam_axvert="cth16"
747      ELSE IF (nvertsave.eq.nvertReffIce(iff)) THEN
748          klevs= numMODISReffIceBins
749          nam_axvert="ReffIce"
750      ELSE IF (nvertsave.eq.nvertReffLiq(iff)) THEN
751          klevs= numMODISReffLiqBins
752          nam_axvert="ReffLiq"
753      ELSE
754           klevs=Nlevout
755           nam_axvert="presnivs"
756      ENDIF
757
758! ug RUSTINE POUR LES Champs 4D
759      IF (PRESENT(ncols)) THEN
760               write(str2,'(i2.2)')ncols
761               nomi=var%name
762               nom="c"//str2//"_"//nomi
763      ELSE
764               nom=var%name
765      END IF
766
767    ! ug On récupère le type écrit de la structure:
768    !       Assez moche, Ã|  refaire si meilleure méthode...
769    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
770       typeecrit = 'once'
771    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
772       typeecrit = 't_min(X)'
773    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
774       typeecrit = 't_max(X)'
775    ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
776       typeecrit = 'inst(X)'
777    ELSE
778       typeecrit = cosp_outfiletypes(iff)
779    ENDIF
780
781    IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
782       zstophym=zoutm_cosp(iff)
783    ELSE
784       zstophym=zdtimemoy_cosp
785    ENDIF
786
787      IF (.not. ok_all_xml) then
788        IF ( var%cles(iff) ) THEN
789          if (prt_level >= 10) then
790              WRITE(lunout,*)'Appel wxios_add_field_to_file 3d nom variable nam_axvert = ',nom, nam_axvert
791          endif
792          CALL wxios_add_field_to_file(nom, 3, cosp_nidfiles(iff), cosp_outfilenames(iff), &
793                                       var%description, var%unit, 1, typeecrit, nam_axvert)
794        ENDIF
795      ENDIF
796
797
798  END SUBROUTINE histdef3d_cosp
799
800
801 SUBROUTINE histwrite2d_cosp(var,field)
802  USE dimphy
803  USE mod_phys_lmdz_para
804  USE ioipsl
805  use iophy
806  USE mod_grid_phy_lmdz, ONLY: nbp_lon
807  USE print_control_mod, ONLY: lunout,prt_level
808
809  USE xios, only: xios_send_field
810
811  IMPLICIT NONE
812  INCLUDE 'clesphys.h'
813
814    TYPE(ctrl_outcosp), INTENT(IN) :: var
815    REAL, DIMENSION(:), INTENT(IN) :: field
816
817    INTEGER :: iff
818
819    REAL,DIMENSION(klon_mpi) :: buffer_omp
820    INTEGER, allocatable, DIMENSION(:) :: index2d
821    REAL :: Field2d(nbp_lon,jj_nb)
822    CHARACTER(LEN=20) ::  nomi, nom
823    character(len=2) :: str2
824    LOGICAL, SAVE  :: firstx
825!$OMP THREADPRIVATE(firstx)
826
827    IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
828
829  ! On regarde si on est dans la phase de définition ou d'écriture:
830  IF(.NOT.cosp_varsdefined) THEN
831!$OMP MASTER
832      print*,'var, cosp_varsdefined dans cosp_varsdefined ',var%name, cosp_varsdefined
833      !Si phase de définition.... on définit
834      CALL conf_cospoutputs(var%name,var%cles)
835      DO iff=1, 3
836         IF (cosp_outfilekeys(iff)) THEN
837            CALL histdef2d_cosp(iff, var)
838         ENDIF
839      ENDDO
840!$OMP END MASTER
841  ELSE
842    !Et sinon on.... écrit
843    IF (SIZE(field)/=klon) &
844  CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1)
845
846    CALL Gather_omp(field,buffer_omp)
847!$OMP MASTER
848    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
849
850! La boucle sur les fichiers:
851      firstx=.true.
852      DO iff=1, 3
853           IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
854                ALLOCATE(index2d(nbp_lon*jj_nb))
855                deallocate(index2d)
856              IF (.not. ok_all_xml) then
857                 if (firstx) then
858                  if (prt_level >= 10) then
859                    WRITE(lunout,*)'xios_send_field variable ',var%name
860                  endif
861                  CALL xios_send_field(var%name, Field2d)
862                   firstx=.false.
863                 endif
864              ENDIF
865           ENDIF
866      ENDDO
867
868      IF (ok_all_xml) THEN
869        if (prt_level >= 1) then
870              WRITE(lunout,*)'xios_send_field variable ',var%name
871        endif
872       CALL xios_send_field(var%name, Field2d)
873      ENDIF
874
875!$OMP END MASTER   
876  ENDIF ! vars_defined
877  IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_cosp ',var%name
878  END SUBROUTINE histwrite2d_cosp
879
880
881! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
882! AI sept 2013
883  SUBROUTINE histwrite3d_cosp(var, field, nverts, ncols)
884  USE dimphy
885  USE mod_phys_lmdz_para
886  USE ioipsl
887  use iophy
888  USE mod_grid_phy_lmdz, ONLY: nbp_lon
889  USE print_control_mod, ONLY: lunout,prt_level
890
891  USE xios, only: xios_send_field
892
893
894  IMPLICIT NONE
895  INCLUDE 'clesphys.h'
896
897    TYPE(ctrl_outcosp), INTENT(IN)    :: var
898    REAL, DIMENSION(:,:), INTENT(IN)  :: field ! --> field(klon,:)
899    INTEGER, INTENT(IN), OPTIONAL     :: ncols ! ug RUSTINE POUR LES Champs 4D.....
900    INTEGER, DIMENSION(3), INTENT(IN) :: nverts
901
902    INTEGER :: iff, k
903
904    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
905    REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
906    INTEGER :: ip, n, nlev
907    INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
908    CHARACTER(LEN=20) ::  nomi, nom
909    character(len=2) :: str2
910    LOGICAL, SAVE  :: firstx
911!$OMP THREADPRIVATE(firstx)
912
913  IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d ',var%name
914
915! ug RUSTINE POUR LES STD LEVS.....
916      IF (PRESENT(ncols)) THEN
917              write(str2,'(i2.2)')ncols
918              nomi=var%name
919              nom="c"//str2//"_"//nomi
920      ELSE
921               nom=var%name
922      END IF
923  ! On regarde si on est dans la phase de définition ou d'écriture:
924  IF(.NOT.cosp_varsdefined) THEN
925      !Si phase de définition.... on définit
926!$OMP MASTER
927      CALL conf_cospoutputs(var%name,var%cles)
928      DO iff=1, 3
929        IF (cosp_outfilekeys(iff)) THEN
930          CALL histdef3d_cosp(iff, var, nverts(iff), ncols)
931        ENDIF
932      ENDDO
933!$OMP END MASTER
934  ELSE
935    !Et sinon on.... écrit
936    IF (SIZE(field,1)/=klon) &
937   CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)                                 
938    nlev=SIZE(field,2)
939
940
941    CALL Gather_omp(field,buffer_omp)
942!$OMP MASTER
943    CALL grid1Dto2D_mpi(buffer_omp,field3d)
944
945! BOUCLE SUR LES FICHIERS
946     firstx=.true.
947     DO iff=1, 3
948        IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
949           ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
950
951          IF (.not. ok_all_xml) then
952           IF (firstx) THEN
953               CALL xios_send_field(nom, Field3d(:,:,1:nlev))
954               IF (prt_level >= 9) WRITE(lunout,*)'xios_send_field ',var%name
955               firstx=.FALSE.
956           ENDIF
957          ENDIF
958         deallocate(index3d)
959        ENDIF
960      ENDDO
961    IF (ok_all_xml) THEN
962     CALL xios_send_field(nom, Field3d(:,:,1:nlev))
963     IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
964    ENDIF
965
966!$OMP END MASTER   
967  ENDIF ! vars_defined
968  IF (prt_level >= 9) write(lunout,*)'End histrwrite3d_cosp ',nom
969  END SUBROUTINE histwrite3d_cosp
970
971
972! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
973! AI sept 2013
974  SUBROUTINE histwrite4d_cosp(var, field)
975  USE dimphy
976  USE mod_phys_lmdz_para
977  USE ioipsl
978  use iophy
979  USE mod_grid_phy_lmdz, ONLY: nbp_lon
980  USE print_control_mod, ONLY: lunout,prt_level
981
982  USE xios, only: xios_send_field
983
984
985  IMPLICIT NONE
986  INCLUDE 'clesphys.h'
987
988    TYPE(ctrl_outcosp), INTENT(IN)    :: var
989    REAL, DIMENSION(:,:,:), INTENT(IN)  :: field ! --> field(klon,:)
990
991    INTEGER :: iff, k
992
993    REAL,DIMENSION(klon_mpi,SIZE(field,2),SIZE(field,3)) :: buffer_omp
994    REAL :: field4d(nbp_lon,jj_nb,SIZE(field,2),SIZE(field,3))
995    INTEGER :: ip, n, nlev, nlev2
996    INTEGER, ALLOCATABLE, DIMENSION(:) :: index4d
997    CHARACTER(LEN=20) ::  nomi, nom
998
999  IF (prt_level >= 9) write(lunout,*)'Begin histrwrite4d ',var%name
1000
1001  IF(cosp_varsdefined) THEN
1002    !Et sinon on.... écrit
1003    IF (SIZE(field,1)/=klon) &
1004   CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)           
1005
1006    nlev=SIZE(field,2)
1007    nlev2=SIZE(field,3)
1008    CALL Gather_omp(field,buffer_omp)
1009!$OMP MASTER
1010    CALL grid1Dto2D_mpi(buffer_omp,field4d)
1011
1012!    IF (ok_all_xml) THEN
1013     CALL xios_send_field(var%name, Field4d(:,:,1:nlev,1:nlev2))
1014     IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
1015!    ENDIF
1016
1017!$OMP END MASTER   
1018  ENDIF ! vars_defined
1019  IF (prt_level >= 9) write(lunout,*)'End histrwrite4d_cosp ',nom
1020  END SUBROUTINE histwrite4d_cosp
1021
1022  SUBROUTINE conf_cospoutputs(nam_var,cles_var)
1023!!! Lecture des noms et cles de sortie des variables dans config.def
1024    !   en utilisant les routines getin de IOIPSL 
1025    use ioipsl
1026    USE print_control_mod, ONLY: lunout,prt_level
1027
1028    IMPLICIT NONE
1029
1030   CHARACTER(LEN=20)               :: nam_var, nnam_var
1031   LOGICAL, DIMENSION(3)           :: cles_var
1032
1033! Lecture dans config.def ou output.def de cles_var et name_var
1034    CALL getin('cles_'//nam_var,cles_var)
1035    CALL getin('name_'//nam_var,nam_var)
1036    IF(prt_level>10) WRITE(lunout,*)'nam_var cles_var ',nam_var,cles_var(:)
1037
1038  END SUBROUTINE conf_cospoutputs
1039
1040 END MODULE lmdz_cosp_output_write_mod
Note: See TracBrowser for help on using the repository browser.