source: LMDZ6/branches/IPSLCM6.0.15/libf/phylmd/cosp/cosp_output_mod.F90 @ 3246

Last change on this file since 3246 was 3246, checked in by idelkadi, 6 years ago

Re-ecriture de la routine de gestion des cles de sorties Cosp :

ecriture d'un module cosp_read_otputkeys.F90 incluant 3 routines :

  • une subroutine pour initialiser au 1er appel a Cosp les Cles
  • une subroutine appelee au 2e passage dans Cosp, permettant de piloter les cles de sorties en fonction de ce qui est demande dans les fichiers xml (dans le cas ou les sorties sont geres par Xios)
  • une routine appelee au 2e passage dans Cosp, permettant de lire les cles dans le ficher cosp_output_nl.txt dans le cas ou les sorties ne sont pas geres par Xios

Nettoyage dans le module cosp_output_write.F90

File size: 24.2 KB
Line 
1! A.Idelkadi sept 2013 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2!! Module pour declarer et initialiser les parametres de controle des fichiers de sorties et des champs a sortir
3!! La routine cosp_output_open (appelee 1 seule fois dans phy_cosp.F90) permet :
4!! de creer les fichiers avec leurs grilles horizontales et verticales
5!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6  MODULE cosp_output_mod
7
8  USE MOD_COSP_CONSTANTS
9  USE MOD_COSP_TYPES
10  use MOD_COSP_Modis_Simulator, only : cosp_modis
11  use mod_modis_sim, only : numMODISReffIceBins, reffICE_binCenters, &
12                            numMODISReffLiqBins, reffLIQ_binCenters
13
14     IMPLICIT NONE
15! cosp_output_mod
16      INTEGER, PRIVATE             :: i
17!!!!!!! Controle des fichier de sorties Cosp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
18      LOGICAL, DIMENSION(3), SAVE  :: cosp_outfilekeys
19      INTEGER, DIMENSION(3), SAVE  :: cosp_nidfiles
20!$OMP THREADPRIVATE(cosp_outfilekeys, cosp_nidfiles)
21      INTEGER, DIMENSION(3), SAVE  :: nhoricosp,nvert,nvertmcosp,nvertcol,nvertbze, &
22                                      nvertsratio,nvertisccp,nvertp,nverttemp,nvertmisr, &
23                                      nvertReffIce,nvertReffLiq,nverttau
24      REAL, DIMENSION(3), SAVE                :: zoutm_cosp
25!$OMP THREADPRIVATE(nhoricosp, nvert,nvertmcosp,nvertcol,nvertsratio,nvertbze,nvertisccp,nvertp,zoutm_cosp,nverttemp,nvertmisr)
26!$OMP THREADPRIVATE(nvertReffIce,nvertReffLiq,nverttau)
27      REAL, SAVE                   :: zdtimemoy_cosp
28!$OMP THREADPRIVATE(zdtimemoy_cosp)
29      CHARACTER(LEN=20), DIMENSION(3), SAVE  :: cosp_outfiletypes
30      CHARACTER(LEN=20), DIMENSION(3), SAVE  :: cosp_outfilenames
31      REAL, DIMENSION(3), SAVE               :: cosp_ecritfiles
32!$OMP THREADPRIVATE(cosp_outfiletypes, cosp_outfilenames, cosp_ecritfiles)
33
34!!!!  Controle des variables a sortir dans les fichiers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
35  TYPE ctrl_outcosp
36     LOGICAL,DIMENSION(3)                 :: cles             !!! Sortir ou non le champs
37     CHARACTER(len=20)                    :: name       
38     CHARACTER(len=150)                   :: description      !!! Nom
39     CHARACTER(len=20)                    :: unit             !!! Unite
40     CHARACTER(len=20),DIMENSION(3)  :: cosp_typeecrit        !!! Operation (ave, inst, ...)
41  END TYPE ctrl_outcosp
42
43! CALIPSO vars
44  TYPE(ctrl_outcosp), SAVE :: o_cllcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
45         "cllcalipso", "Lidar Low-level Cloud Fraction", "1", (/ ('', i=1, 3) /))                                   
46  TYPE(ctrl_outcosp), SAVE :: o_clmcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
47         "clmcalipso", "Lidar Mid-level Cloud Fraction", "1", (/ ('', i=1, 3) /))
48  TYPE(ctrl_outcosp), SAVE :: o_clhcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
49         "clhcalipso", "Lidar High-level Cloud Fraction", "1", (/ ('', i=1, 3) /))
50  TYPE(ctrl_outcosp), SAVE :: o_cltcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
51         "cltcalipso", "Lidar Total Cloud Fraction", "1", (/ ('', i=1, 3) /))
52  TYPE(ctrl_outcosp), SAVE :: o_clcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
53         "clcalipso", "Lidar Cloud Fraction (532 nm)", "1", (/ ('', i=1, 3) /))
54  TYPE(ctrl_outcosp), SAVE :: o_cfad_lidarsr532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
55         "cfad_lidarsr532", "Lidar Scattering Ratio CFAD (532 nm)", "1", (/ ('', i=1, 3) /))   
56  TYPE(ctrl_outcosp), SAVE :: o_parasol_refl = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
57         "parasol_refl", "PARASOL-like mono-directional reflectance","1", (/ ('', i=1, 3) /))
58  TYPE(ctrl_outcosp), SAVE :: o_parasol_crefl = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &             
59         "parasol_crefl", "PARASOL-like mono-directional reflectance (integral)","1", (/ ('', i=1, 3) /))                 
60  TYPE(ctrl_outcosp), SAVE :: o_Ncrefl = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
61         "Ncrefl", "Nb PARASOL-like mono-directional reflectance (integral)","1", (/ ('', i=1, 3) /))
62  TYPE(ctrl_outcosp), SAVE :: o_atb532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
63         "atb532", "Lidar Attenuated Total Backscatter (532 nm)","1", (/ ('', i=1, 3) /))
64  TYPE(ctrl_outcosp), SAVE :: o_beta_mol532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
65         "beta_mol532", "Lidar Molecular Backscatter (532 nm)","m-1 sr-1", (/ ('', i=1, 3) /))
66!! AI  11 2015
67  TYPE(ctrl_outcosp), SAVE :: o_cllcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
68         "cllcalipsoice", "CALIPSO Ice-Phase Low Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 
69  TYPE(ctrl_outcosp), SAVE :: o_cllcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
70         "cllcalipsoliq", "CALIPSO Liq-Phase Low Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
71  TYPE(ctrl_outcosp), SAVE :: o_clmcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
72         "clmcalipsoice", "CALIPSO Ice-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
73  TYPE(ctrl_outcosp), SAVE :: o_clmcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
74         "clmcalipsoliq", "CALIPSO Liq-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))                 
75  TYPE(ctrl_outcosp), SAVE :: o_clhcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
76         "clhcalipsoice", "CALIPSO Ice-Phase High Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 
77  TYPE(ctrl_outcosp), SAVE :: o_clhcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
78         "clhcalipsoliq", "CALIPSO Liq-Phase High Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
79  TYPE(ctrl_outcosp), SAVE :: o_cltcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
80         "cltcalipsoice", "CALIPSO Ice-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
81  TYPE(ctrl_outcosp), SAVE :: o_cltcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
82         "cltcalipsoliq", "CALIPSO Liq-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))                 
83  TYPE(ctrl_outcosp), SAVE :: o_cllcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
84         "cllcalipsoun", "CALIPSO Undefined-Phase Low Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 
85  TYPE(ctrl_outcosp), SAVE :: o_clmcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
86         "clmcalipsoun", "CALIPSO Undefined-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
87  TYPE(ctrl_outcosp), SAVE :: o_clhcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
88         "clhcalipsoun", "CALIPSO Undefined-Phase High Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
89  TYPE(ctrl_outcosp), SAVE :: o_cltcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
90         "cltcalipsoun", "CALIPSO Undefined-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /))
91  TYPE(ctrl_outcosp), SAVE :: o_clcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
92         "clcalipsoice", "Lidar Ice-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
93  TYPE(ctrl_outcosp), SAVE :: o_clcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
94         "clcalipsoliq", "Lidar Liq-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
95  TYPE(ctrl_outcosp), SAVE :: o_clcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
96         "clcalipsoun", "Lidar Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))     
97  TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmpice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
98         "clcalipsotmpice", "Lidar Ice-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
99  TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmpliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
100         "clcalipsotmpliq", "Lidar Liq-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
101  TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmpun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
102         "clcalipsotmpun", "Lidar Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /))
103  TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
104         "clcalipsotmp", "Lidar Cloud Fraction", "%", (/ ('', i=1, 3) /))
105
106  TYPE(ctrl_outcosp), SAVE :: o_clopaquecalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &  !OPAQ
107         "clopaquecalipso", "Lidar Opaque Cloud Fraction", "%", (/ ('', i=1, 3) /))             !OPAQ
108  TYPE(ctrl_outcosp), SAVE :: o_clthincalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &    !OPAQ
109         "clthincalipso", "Lidar Thin Cloud Fraction", "%", (/ ('', i=1, 3) /))                 !OPAQ
110  TYPE(ctrl_outcosp), SAVE :: o_clzopaquecalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & !OPAQ
111         "clzopaquecalipso", "Lidar mean opacity altitude", "m", (/ ('', i=1, 3) /))            !OPAQ
112  TYPE(ctrl_outcosp), SAVE :: o_clcalipsoopaque = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &  !OPAQ
113         "clcalipsoopaque", "Lidar Opaque profile Cloud Fraction", "%", (/ ('', i=1, 3) /))     !OPAQ
114  TYPE(ctrl_outcosp), SAVE :: o_clcalipsothin = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &    !OPAQ
115         "clcalipsothin", "Lidar Thin profile Cloud Fraction", "%", (/ ('', i=1, 3) /))         !OPAQ
116  TYPE(ctrl_outcosp), SAVE :: o_clcalipsozopaque = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & !OPAQ
117         "clcalipsozopaque", "Lidar z_opaque Fraction", "%", (/ ('', i=1, 3) /))                !OPAQ
118  TYPE(ctrl_outcosp), SAVE :: o_clcalipsoopacity = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & !OPAQ
119         "clcalipsoopacity", "Lidar opacity Fraction", "%", (/ ('', i=1, 3) /))                 !OPAQ
120
121  TYPE(ctrl_outcosp), SAVE :: o_proftemp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &         !TIBO
122         "proftemp", "Temperature profiles (40 lev)", "K", (/ ('', i=1, 3) /))                  !TIBO
123  TYPE(ctrl_outcosp), SAVE :: o_profSR = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &           !TIBO
124         "profSR", "Lidar Scattering Ratio profiles (532 nm)", "1", (/ ('', i=1, 3) /))         !TIBO
125
126! Radar Cloudsat
127  TYPE(ctrl_outcosp), SAVE :: o_cfadDbze94 = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
128         "cfadDbze94", "CloudSat Radar Reflectivity CFAD", "%", (/ ('', i=1, 3) /))
129  TYPE(ctrl_outcosp), SAVE :: o_dbze94 = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
130         "dbze94", "CloudSat Radar Reflectivity", "%", (/ ('', i=1, 3) /))
131
132! Calipso + Cloudsat
133  TYPE(ctrl_outcosp), SAVE :: o_clcalipso2 = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
134         "clcalipso2", "CALIPSO Cloud Fraction Undetected by CloudSat", "1", (/ ('', i=1, 3) /))
135  TYPE(ctrl_outcosp), SAVE :: o_cltlidarradar = ctrl_outcosp((/ .TRUE., .TRUE.,.TRUE. /), &         
136         "cltlidarradar", "Lidar and Radar Total Cloud Fraction", "%", (/ ('', i=1, 3) /))
137     
138! ISCCP vars
139  TYPE(ctrl_outcosp), SAVE :: o_sunlit = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
140         "sunlit", "1 for day points, 0 for nightime","1",(/ ('', i=1, 3) /))                   
141  TYPE(ctrl_outcosp), SAVE :: o_clisccp2 = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
142         "clisccp2", "Cloud Fraction as Calculated by the ISCCP Simulator","%", (/ ('', i=1, 3) /))
143  TYPE(ctrl_outcosp), SAVE :: o_boxtauisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
144         "boxtauisccp", "Optical Depth in Each Column as Calculated by the ISCCP Simulator","1", (/ ('', i=1, 3) /))
145  TYPE(ctrl_outcosp), SAVE :: o_boxptopisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
146         "boxptopisccp", "Cloud Top Pressure in Each Column as Calculated by the ISCCP Simulator","Pa", (/ ('', i=1, 3) /))
147  TYPE(ctrl_outcosp), SAVE :: o_tclisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
148          "tclisccp", "Total Cloud Fraction as Calculated by the ISCCP Simulator", "%", (/ ('', i=1, 3) /))
149  TYPE(ctrl_outcosp), SAVE :: o_ctpisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
150          "ctpisccp", "Mean Cloud Top Pressure as Calculated by the ISCCP Simulator", "Pa", (/ ('', i=1, 3) /))
151  TYPE(ctrl_outcosp), SAVE :: o_tauisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
152          "tauisccp", "Optical Depth as Calculated by the ISCCP Simulator", "1", (/ ('', i=1, 3) /))
153  TYPE(ctrl_outcosp), SAVE :: o_albisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
154          "albisccp", "Mean Cloud Albedo as Calculated by the ISCCP Simulator", "1", (/ ('', i=1, 3) /))
155  TYPE(ctrl_outcosp), SAVE :: o_meantbisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
156          "meantbisccp", " Mean all-sky 10.5 micron brightness temperature as calculated &
157           by the ISCCP Simulator","K", (/ ('', i=1, 3) /))
158  TYPE(ctrl_outcosp), SAVE :: o_meantbclrisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
159          "meantbclrisccp", "Mean clear-sky 10.5 micron brightness temperature as calculated &
160           by the ISCCP Simulator","K", (/ ('', i=1, 3) /))
161
162! MISR simulator
163  TYPE(ctrl_outcosp), SAVE :: o_clMISR = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
164         "clMISR", "Cloud Fraction as Calculated by the MISR Simulator","%", (/ ('', i=1, 3) /))
165
166! MODIS simulator
167  TYPE(ctrl_outcosp), SAVE :: o_cllmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
168         "cllmodis", "MODIS Low-level Cloud Fraction", "%", (/ ('', i=1, 3) /))                                   
169  TYPE(ctrl_outcosp), SAVE :: o_clmmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
170         "clmmodis", "MODIS Mid-level Cloud Fraction", "%", (/ ('', i=1, 3) /))
171  TYPE(ctrl_outcosp), SAVE :: o_clhmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
172         "clhmodis", "MODIS High-level Cloud Fraction", "%", (/ ('', i=1, 3) /))
173  TYPE(ctrl_outcosp), SAVE :: o_cltmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
174         "cltmodis", "MODIS Total Cloud Fraction", "%", (/ ('', i=1, 3) /))
175  TYPE(ctrl_outcosp), SAVE :: o_clwmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
176         "clwmodis", "MODIS Cloud Fraction water mean", "%", (/ ('', i=1, 3) /))
177  TYPE(ctrl_outcosp), SAVE :: o_climodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
178         "climodis", "MODIS Cloud Fraction ice mean", "%", (/ ('', i=1, 3) /))
179  TYPE(ctrl_outcosp), SAVE :: o_tautmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
180         "tautmodis", "MODIS Optical_Thickness_Total_Mean", "1", (/ ('', i=1, 3) /))                                   
181  TYPE(ctrl_outcosp), SAVE :: o_tauwmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
182         "tauwmodis", "MODIS Optical_Thickness_Water_Mean", "1", (/ ('', i=1, 3) /))
183  TYPE(ctrl_outcosp), SAVE :: o_tauimodis= ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
184         "tauimodis", "MODIS Optical_Thickness_Ice_Mean", "1", (/ ('', i=1, 3) /))
185  TYPE(ctrl_outcosp), SAVE :: o_tautlogmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
186         "tautlogmodis", "MODIS Optical_Thickness_Total_logMean", "1", (/ ('', i=1, 3) /))                                   
187  TYPE(ctrl_outcosp), SAVE :: o_tauwlogmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
188         "tauwlogmodis", "MODIS Optical_Thickness_Water_logMean", "1", (/ ('', i=1, 3) /))
189  TYPE(ctrl_outcosp), SAVE :: o_tauilogmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
190         "tauilogmodis", "MODIS Optical_Thickness_Ice_logMean", "1", (/ ('', i=1, 3) /))
191  TYPE(ctrl_outcosp), SAVE :: o_reffclwmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
192         "reffclwmodis", "Modis Cloud_Particle_Size_Water_Mean", "m", (/ ('', i=1, 3) /))
193  TYPE(ctrl_outcosp), SAVE :: o_reffclimodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
194         "reffclimodis", "Modis Cloud_Particle_Size_Ice_Mean", "m", (/ ('', i=1, 3) /))
195  TYPE(ctrl_outcosp), SAVE :: o_pctmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
196         "pctmodis", "Modis Cloud_Top_Pressure_Total_Mean", "Pa", (/ ('', i=1, 3) /))
197  TYPE(ctrl_outcosp), SAVE :: o_lwpmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
198         "lwpmodis", "Modis Liquid_Water_Path_Mean", "kg m-2", (/ ('', i=1, 3) /))
199  TYPE(ctrl_outcosp), SAVE :: o_iwpmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
200         "iwpmodis", "Modis Ice_Water_Path_Mean", "kg m-2", (/ ('', i=1, 3) /))
201  TYPE(ctrl_outcosp), SAVE :: o_clmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
202         "clmodis", "MODIS Cloud Area Fraction", "%", (/ ('', i=1, 3) /))
203  TYPE(ctrl_outcosp), SAVE :: o_crimodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
204         "crimodis", "Optical_Thickness_vs_ReffIce from Modis", "%", (/ ('',i=1, 3) /))         
205  TYPE(ctrl_outcosp), SAVE :: o_crlmodis = ctrl_outcosp((/ .TRUE., .TRUE.,.TRUE. /), &
206         "crlmodis", "Optical_Thickness_vs_ReffLiq from Modis", "%", (/ ('',i=1, 3) /))         
207
208! Rttovs simulator
209  TYPE(ctrl_outcosp), SAVE :: o_tbrttov = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
210         "tbrttov", "Rttovs Cloud Area Fraction", "%", (/ ('', i=1, 3) /))
211
212! Scops and others
213  TYPE(ctrl_outcosp), SAVE :: o_fracout = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
214         "fracout", "Subcolumn output from SCOPS", "%", (/ ('', i=1, 3) /))
215
216  LOGICAL, SAVE :: cosp_varsdefined = .FALSE. ! ug PAS THREADPRIVATE ET C'EST NORMAL
217  REAL, SAVE  :: Cosp_fill_value
218!$OMP THREADPRIVATE(Cosp_fill_value)
219 
220
221CONTAINS
222
223!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
224!!!!!!!!! Ouverture des fichier et definition des  axes!!!!!!!!
225  !! histbeg, histvert
226!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
227
228  SUBROUTINE cosp_output_open(Nlevlmdz, Ncolumns, presnivs, dtime, freq_cosp, &
229                              ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml,  &
230                              ecrit_mth, ecrit_day, ecrit_hf, use_vgrid, vgrid, stlidar)
231
232  USE iophy
233  USE ioipsl
234  USE phys_cal_mod
235  USE time_phylmdz_mod, ONLY: day_ref, annee_ref, day_ini, start_time, itau_phy
236  USE print_control_mod, ONLY: lunout
237
238#ifdef CPP_XIOS
239    ! ug Pour les sorties XIOS
240    USE wxios
241#endif
242
243  IMPLICIT NONE
244
245!!! Variables d'entree
246  integer                  :: Nlevlmdz, Ncolumns      ! Number of levels
247  real,dimension(Nlevlmdz) :: presnivs
248  real                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth
249  logical                  :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, use_vgrid, ok_all_xml                   
250  type(cosp_vgrid)   :: vgrid   ! Information on vertical grid of stats
251  type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator
252
253!!! Variables locales
254  integer                   :: idayref, iff, ii
255  real                      :: zjulian,zjulian_start
256  real,dimension(Ncolumns)  :: column_ax
257  real,dimension(DBZE_BINS) ::  dbze_ax
258  CHARACTER(LEN=20), DIMENSION(3)  :: chfreq = (/ '1day', '1d  ', '3h  ' /)           
259  real,parameter,dimension(SR_BINS) :: sratio_ax = (/0.005, &
260                                                  0.605,2.09,4.,6., &
261                                          8.5,12.5,17.5,22.5,27.5,35.,45.,55.,70.,50040./)
262
263!!! Variables d'entree
264
265#ifdef CPP_XIOS
266    ! ug Variables utilisées pour récupérer le calendrier pour xios
267    INTEGER :: x_an, x_mois, x_jour
268    REAL :: x_heure
269    INTEGER :: ini_an, ini_mois, ini_jour
270    REAL :: ini_heure
271#endif
272
273    WRITE(lunout,*) 'Debut cosp_output_mod.F90'
274    print*,'cosp_varsdefined',cosp_varsdefined
275    ! Initialisations (Valeurs par defaut)
276
277!! Definition valeurs axes
278    do ii=1,Ncolumns
279      column_ax(ii) = real(ii)
280    enddo
281
282    do i=1,DBZE_BINS
283     dbze_ax(i) = CFAD_ZE_MIN + CFAD_ZE_WIDTH*(i - 0.5)
284    enddo
285 
286    cosp_outfilenames(1) = 'histmthCOSP'
287    cosp_outfilenames(2) = 'histdayCOSP'
288    cosp_outfilenames(3) = 'histhfCOSP'
289
290    cosp_outfiletypes(1) = 'ave(X)'
291    cosp_outfiletypes(2) = 'ave(X)'
292    cosp_outfiletypes(3) = 'ave(X)'
293
294    cosp_outfilekeys(1) = ok_mensuelCOSP
295    cosp_outfilekeys(2) = ok_journeCOSP
296    cosp_outfilekeys(3) = ok_hfCOSP
297
298    cosp_ecritfiles(1) = mth_len*86400.
299    cosp_ecritfiles(2) = 1.*86400.
300    cosp_ecritfiles(3) = 0.125*86400.
301
302! Lecture des parametres dans output.def ou config.def
303
304    CALL getin('cosp_outfilenames',cosp_outfilenames)
305    CALL getin('cosp_outfilekeys',cosp_outfilekeys)
306    CALL getin('cosp_ecritfiles',cosp_ecritfiles)
307    CALL getin('cosp_outfiletypes',cosp_outfiletypes)
308
309    WRITE(lunout,*)'cosp_outfilenames=',cosp_outfilenames
310    WRITE(lunout,*)'cosp_outfilekeys=',cosp_outfilekeys
311    WRITE(lunout,*)'cosp_ecritfiles=',cosp_ecritfiles
312    WRITE(lunout,*)'cosp_outfiletypes=',cosp_outfiletypes
313   
314    idayref = day_ref
315    CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
316    CALL ymds2ju(annee_ref, 1, day_ini, start_time, zjulian_start)
317
318#ifdef CPP_XIOS
319   
320! recuperer la valeur indefine Xios
321!    CALL xios_get_field_attr("clcalipso",default_value=Cosp_fill_value)
322!         Cosp_fill_value=missing_val
323          Cosp_fill_value=0.
324         print*,'Cosp_fill_value=',Cosp_fill_value
325!    if (use_vgrid) then
326!      print*,'vgrid%Nlvgrid, vgrid%z = ',vgrid%Nlvgrid, vgrid%z
327        CALL wxios_add_vaxis("height", vgrid%Nlvgrid, vgrid%z)
328     print*,'wxios_add_vaxis '
329!    else
330!         WRITE(lunout,*) 'wxios_add_vaxis "presnivs", vgrid%Nlvgrid ',vgrid%Nlvgrid
331!        CALL wxios_add_vaxis("presnivs", vgrid%Nlvgrid, presnivs)
332!    endif
333    WRITE(lunout,*) 'wxios_add_vaxis height_mlev, Nlevlmdz ',Nlevlmdz
334    CALL wxios_add_vaxis("height_mlev", Nlevlmdz, vgrid%mz)
335    WRITE(lunout,*) 'wxios_add_vaxis sza, PARASOL_NREFL ',PARASOL_NREFL
336    CALL wxios_add_vaxis("sza", PARASOL_NREFL, PARASOL_SZA)
337    WRITE(lunout,*) 'wxios_add_vaxis pressure2 ',7
338    CALL wxios_add_vaxis("pressure2", 7, ISCCP_PC)
339    WRITE(lunout,*) 'wxios_add_vaxis column ',Ncolumns
340    CALL wxios_add_vaxis("column", Ncolumns, column_ax)
341
342! AI nov 2015
343   CALL wxios_add_vaxis("temp", LIDAR_NTEMP, LIDAR_PHASE_TEMP)
344   CALL wxios_add_vaxis("cth16", MISR_N_CTH, MISR_CTH)
345   CALL wxios_add_vaxis("dbze", DBZE_BINS, dbze_ax)
346   CALL wxios_add_vaxis("scatratio", SR_BINS, sratio_ax)
347   CALL wxios_add_vaxis("ReffIce", numMODISReffIceBins, reffICE_binCenters)
348   CALL wxios_add_vaxis("ReffLiq", numMODISReffLiqBins, reffLIQ_binCenters)
349   print*,'reffICE_binCenters=',reffICE_binCenters
350   CALL wxios_add_vaxis("tau", 7, ISCCP_TAU)
351
352#endif
353   
354    zdtimemoy_cosp = freq_COSP         ! Frequence ou l on moyenne
355
356    DO iff=1,3
357       zoutm_cosp(iff) = cosp_ecritfiles(iff) ! Frequence ou l on ecrit en seconde
358
359       IF (cosp_outfilekeys(iff)) THEN
360           CALL histbeg_phy_all(cosp_outfilenames(iff),itau_phy,zjulian,&
361             dtime,nhoricosp(iff),cosp_nidfiles(iff))
362!           print*,'histbeg_phy nhoricosp(iff),cosp_nidfiles(iff)', &
363!                    nhoricosp(iff),cosp_nidfiles(iff)
364
365#ifdef CPP_XIOS
366        IF (.not. ok_all_xml) then
367         WRITE(lunout,*) 'wxios_add_file ',cosp_outfilenames(iff)
368         CALL wxios_add_file(cosp_outfilenames(iff),chfreq(iff),10)
369        ENDIF
370#endif
371
372#ifndef CPP_IOIPSL_NO_OUTPUT
373! Definition de l'axe vertical
374       if (use_vgrid) then
375! Axe vertical Cosp 40 niveaux (en m)
376      CALL histvert(cosp_nidfiles(iff),"height","height","m",vgrid%Nlvgrid,vgrid%z,nvert(iff))
377       else
378! Axe vertical modele LMDZ presnivs
379      CALL histvert(cosp_nidfiles(iff),"presnivs","Vertical levels","Pa",vgrid%Nlvgrid,presnivs,nvert(iff),"down")
380       endif
381! Axe vertical niveaux modele (en m)
382      CALL histvert(cosp_nidfiles(iff),"height_mlev","height_mlev","m",Nlevlmdz,vgrid%mz,nvertmcosp(iff))
383
384      CALL histvert(cosp_nidfiles(iff),"sza","solar_zenith_angle","degrees",PARASOL_NREFL,PARASOL_SZA,nvertp(iff))
385
386      CALL histvert(cosp_nidfiles(iff),"pressure2","pressure","mb",7,ISCCP_PC,nvertisccp(iff),"down")
387
388      CALL histvert(cosp_nidfiles(iff),"column","column","count",Ncolumns,column_ax,nvertcol(iff)) !DBUG
389
390      CALL histvert(cosp_nidfiles(iff),"temp","temperature","C",LIDAR_NTEMP,LIDAR_PHASE_TEMP,nverttemp(iff))
391
392      CALL histvert(cosp_nidfiles(iff),"cth16","altitude","m",MISR_N_CTH,MISR_CTH,nvertmisr(iff))
393 
394      CALL histvert(cosp_nidfiles(iff),"ReffIce","Effective_particle_size_Ice","microns",numMODISReffIceBins, reffICE_binCenters, &
395                    nvertReffIce(iff))                                         
396     
397      CALL histvert(cosp_nidfiles(iff),"ReffLiq","Effective_particle_size_Liq","microns",numMODISReffLiqBins, reffLIQ_binCenters, &                                 
398                    nvertReffLiq(iff))
399
400      CALL histvert(cosp_nidfiles(iff),"dbze","equivalent_reflectivity_factor","dBZ",DBZE_BINS,dbze_ax,nvertbze(iff))
401     
402      CALL histvert(cosp_nidfiles(iff),"scatratio","backscattering_ratio","1",SR_BINS,sratio_ax,nvertsratio(iff))
403
404      CALL histvert(cosp_nidfiles(iff),"tau","cloud optical depth","1",7,ISCCP_TAU,nverttau(iff))
405     
406!!! Valeur indefinie en cas IOIPSL
407     Cosp_fill_value=0.
408
409#endif
410
411      ENDIF
412  ENDDO
413
414    end SUBROUTINE cosp_output_open
415
416 END MODULE cosp_output_mod
Note: See TracBrowser for help on using the repository browser.