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

Last change on this file since 3511 was 3491, checked in by idelkadi, 5 years ago

Integration of version 2 of the COSP simulator in LMDZ
This line, and those below, will be ignored--

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