source: trunk/LMDZ.MARS/util/simu_MCS.F90 @ 3026

Last change on this file since 3026 was 2979, checked in by abierjon, 19 months ago

Mars GCM:
Adapt simu_MCS.F90 so that it also recognizes new dust opacity names from aeroptical (since r2817 : "opa_dust" instead of "opadust")
(retrocompatible with old names as well)

AB

File size: 98.1 KB
Line 
1program simu_MCS
2! program for a MCS observer simulator of GCM data
3! author : Antoine Bierjon, 2019-2020
4! contact : antoine.bierjon@lmd.jussieu.fr
5!
6!===================================================================================================
7!     PREFACE
8!===================================================================================================
9! This program loads on one hand, a GCM file, which can be :
10!       - a GCM diagfi.nc or concat.nc that covers the observation period,
11!       - a GCM stats file (stats.nc) which gets extended to cover the observation period
12!
13! On the other hand, it loads a MRO/MCS data file (binned by Luca Montabone). 
14! This MCS file serves then as a reference for the interpolation and the binning of the
15! GCM variables contained in the GCM file and given as inputs in the simu_MCS.def
16!
17! Since the MCS data is binned by intervals of Ls, the GCM simulation's data is interpolated at
18! the MCS spatial coordinates, at every GCM sol value contained in each interval of Ls, before 
19! being averaged to create output bins for each interval. The binning in sols also takes into
20! account the variability of Local Time in the bin and tries to represent it (with a number of LT
21! values in each sol bin equal to the number of values in each associated MCS bin : numbintemp/dust/wice,
22! and centered around the MCS bin LT average : timeave).
23!
24! There are also specific GCM variables that the program looks for in order to make them
25! comparable with their equivalent in MCS files. These variables are :
26!                                     GCM                         MCS
27!                           # temp                    --->   dtemp,ntemp
28!                           # dso(/dsodust/qdust)+rho --->   ddust,ndust (dust opacity/km)
29!                           # h2o_ice+rho             --->   dwice,nwice (water ice opacity/km)
30!
31! For dust especially, if a dust opacity variable has been created in the output file, the program also
32! computes the ratio of the Column-integrated Dust Optical Depths from the binned GCM file and the
33! MCS file, that can then be used to normalize the dust opacity profiles when doing comparisons.
34!
35! Eventually, the program outputs a netcdf file, filled with the GCM binned data for dayside
36! and nightside and edited with the same format than the MCS file (and with the same
37! dimensions' declaration order).
38!
39! Minimal requirements :
40!     - the MCS file must contain the variables :
41!                             dtimeave,dtimemax,dtimemin,
42!                             dtemp,dnumbintemp,
43!                             ddust,dnumbindust,
44!                             dwice,dnumbinwice,
45!                             ntimeave,ntimemax,ntimemin,
46!                             ntemp,nnumbintemp,
47!                             ndust,nnumbindust,
48!                             nwice,nnumbinwice
49!     - the GCM file must :
50!                           # have the same altitude type as the MCS file ;
51!                           # cover completely the observation period
52!
53! See also NOTA BENE in section 2.2
54!
55!
56!
57! Algorithm :
58!  0. Variable declarations
59!  1. OPENING OF THE FILES AND INITIALIZATION OF THE DIMENSIONS
60!    1.1 MCS data file : obsfile
61!      1.1.1 Open the Observer data file
62!      1.1.2 Get dimensions lon,lat,alt,time from the observation file
63!    1.2. GCM simulation file : gcmfile
64!      1.2.1 Open the GCM simulation file
65!      1.2.2 Get dimensions lon,lat,alt,time from the GCM file
66!    1.3 Create the output file & initialize the coordinates
67!  2. VARIABLES MANAGEMENT
68!    2.1 List of the GCM variables to be interpolated
69!      2.1.1 Read the GCM variables
70!      2.1.2 Handle dust and wice opacities (first set-ups)
71!    2.2 Definition of LT variables from obsfile to outfile
72![day/night loop begins...
73!      2.2.1 Average of Local Time in the OBS bins
74!      2.2.2 Maximum of Local Time in the OBS bins
75!      2.2.3 Minimum of Local Time in the OBS bins
76!    2.3 Definition of numbin variables from obsfile to outfile
77!      2.3.1 Number of values in the OBS "temp" bins
78!      2.3.2 Number of values in the OBS "dust" bins
79!      2.3.3 Number of values in the OBS "wice" bins
80!    2.4 Opening of the GCM variables
81! [var loop begins...
82!      2.4.1 Generic reading of the variable
83!      2.4.2 Handle dust and wice opacities (second part)
84!    2.5 Opening of the associated MCS variables
85!      2.5.1 MCS reference variable (for the missing values)
86!      2.5.2 Number of values in the OBS bin (for the sol binning)
87!    2.6 Definition of GCM variables in outfile
88!  3. EXTRACTION OF THE VARIABLE
89!  [coordinates loop begins...
90!    3.1 Do some checks and preparations before the extraction
91!    3.2 Compute GCM sol date corresponding to Observer Ls (via m_(min/max)sol)
92!        and LT (via OBSLT(min/max))
93!    3.3 Do the interpolation and binning for the given location
94!  ..coordinates loop ends]
95!    3.4 Write the data in the netcdf output file
96! ..var loop ends]
97!  4. CDOD RATIO (tau_GCM/tau_MCS)
98!    4.1 Preliminary checks
99!    4.2 tau_ratio computation
100!    4.3 Write tau_ratio in the netcdf output file
101!  5. END OF THE DAY/NIGHT LOOP
102!..day/night loop ends]
103!  6. CLOSE THE FILES
104!
105!  Subroutines
106!    extraction
107!    inidim
108!    ls2sol
109!    gen_sol_list
110!    status_check
111!    LTmod
112!===================================================================================================
113
114
115use netcdf
116
117
118!===================================================================================
119! 0. Variable declarations
120!===================================================================================
121
122implicit none ! for no implicitly typed variables
123
124!------------------------
125! Files:
126character(len=256) :: gcmfile ! GCM simulation file
127logical :: is_stats = .false. ! to check if the GCM file is a stats.nc or a diagfi.nc file
128character(len=256) :: obsfile ! observation file = MCS/Observer data file
129character(len=256) :: outfile ! output file
130
131!------------------------
132! NetCDF stuff
133integer :: status                                                    ! NetCDF routines return code
134character (len=256) :: error_text                                    ! to store the error text
135integer :: gcmfid                                                    ! NetCDF gcm file ID
136integer :: obsfid                                                    ! NetCDF observation file ID
137integer :: outfid                                                    ! NetCDF output file ID
138integer :: GCMvarid, OBSvarid, LT_id, numbin_id, outvarid            ! to store the ID of a variable
139integer :: lat_dimid_obs,lon_dimid_obs,alt_dimid_obs,time_dimid_obs  ! dimensions' ID in OBS and output files
140integer :: lat_dimid_gcm,lon_dimid_gcm,alt_dimid_gcm,time_dimid_gcm  ! dimensions' ID in GCM file
141integer :: GCMvarshape(4), OBSvarshape(4), LTshape(3),numbinshape(4) ! to store a variable's coordinates order
142
143!------------------------
144! Dimensions
145real,dimension(:),allocatable :: GCMlon, OBSlon  ! longitude in the GCM & the Observer files
146integer GCMlonlen, OBSlonlen                     ! # of grid points along GCMlon & OBSlon
147real,dimension(:),allocatable :: GCMlat, OBSlat  ! latitude in the GCM & the Observer files
148integer GCMlatlen, OBSlatlen                     ! # of grid points along GCMlat & OBSlat
149real,dimension(:),allocatable :: GCMalt, OBSalt  ! altitude/pressure in the GCM & the Observer files
150integer GCMaltlen, OBSaltlen                     ! # of grid point along GCMalt & OBSalt
151character(len=1) :: GCMalttype, OBSalttype       ! altitude coord. type:'z' (altitude, m) 'p' (pressure, Pa)
152real,dimension(:),allocatable :: GCMtime, OBSLs  ! time in the GCM diagfi (sols) & the Observer files (Ls)
153real,dimension(:),allocatable :: GCMstatstime    ! time in the GCM stats file (LT at lon 0°)
154integer :: GCMtimelen, GCMstatstimelen, OBSLslen ! # of points along GCMtime, GCMstatstime, OBSLs
155real :: starttimeoffset=0.                       ! offset (in sols) wrt Ls=0 of sol 0 in GCM file
156
157!------------------------
158! Variables
159character(len=10) :: dayornight                        ! are we in the "dayside" or "nightside" loop?
160character(len=64),dimension(:),allocatable :: gcm_vars ! list of GCM variables to interpolate
161character(len=10),dimension(15) :: notprocessed        ! names of the (15) variables that won't be processed   
162integer :: nbvarfile,Nnotprocessed                     ! nbs of variables to deal with the non-processed ones
163integer :: nbvar                                       ! nb of variables that will be processed
164logical :: var_ok                                      ! is this variable to be processed?
165logical :: dustok1,dustok2,dustok3,wiceok              ! is it possible to compute opacities and how?
166character(len=64) :: GCMvarname,OBSvarname,outvarname  ! name of the variables
167integer :: nbdim                                       ! nb of dimensions of a variable
168real,dimension(:,:,:,:),allocatable :: GCM_var,OBS_var ! the 4D variable extracted from GCM & OBS files
169real,dimension(:,:,:,:),allocatable :: GCM_rho         ! atmospheric density for opacities' computation
170character(len=64) :: long_name,units,comment           ! netcdf attributes of the variable
171
172character(len=64) :: OBSLTave_name,OBSLTmax_name,OBSLTmin_name
173                                                       ! names of the average, max and min of LT
174real,dimension(:,:,:),allocatable :: OBSLT,OBSLTmax,OBSLTmin
175                                                       ! 3D variables extracted from obsfile (ave, max and min of LT in a bin)
176
177character (len=64) :: numbin_name                      ! name of the nb of values in an OBS bin
178real,dimension(:,:,:,:),allocatable :: numbin          ! nb of values in an OBS temp/dust/wice bin
179
180real :: GCMmiss_val, OBSmiss_val, LTmiss_val           ! value to denote non-existant data
181real :: extr_value                                     ! result of the extraction subroutine
182real, dimension(:,:,:,:), allocatable :: outvar        ! outvar(,,,): 4D array to store the output variable's data
183
184!------------------------
185! Time binning management
186real :: OBSdeltaLs            ! difference of Ls between each observation bin
187real :: sol, maxsol, minsol   ! sol date corresponding to Observed Ls and LT
188integer :: m_maxsol, m_minsol ! indexes of the maximum and minimum GCM sol taken in a bin for interpolation
189
190external LTmod     ! declaration of the function LTmod
191real :: LTmod      ! declaration of the type of the function LTmod
192integer :: LTcount ! nb of LT samples on which the interpolation is performed,
193                   ! for every LT interval (= numbin[lon,lat,alt,Ls])
194
195integer :: solcount                           ! number of GCM sol integer values in one Ls interval
196real,dimension(:),allocatable :: int_sol_list ! list of the integer values of GCM sol
197real,dimension(:),allocatable :: sol_list     ! list of the sol values used for the interpolation
198integer :: solerrcount                        ! nb of GCM missing values during interpolation, removed for the binning
199integer :: errcount = 0                       ! total number of GCM missing values
200real :: solbinned_value                       ! extracted value averaged on sol samples, which is finally put in the output bin
201
202!------------------------
203! Extraction & loop indices
204real :: lon_val, lat_val, alt_val, Ls_val, LT_val ! where and when the output file is written at
205
206integer :: i,j,k,l ! loop iteration indices
207integer :: m       ! sol binning loops iteration index
208integer :: v,vnot  ! variable loops indices
209
210!------------------------
211! CDOD ratio (tau_GCM/tau_MCS)
212logical :: tau_ratio_ok ! true if it is possible to compute the CDOD ratio
213
214character(len=64)::out_dztauname,OBS_dztauname,OBS_tempname ! input variable names in files
215integer :: out_dztauid,OBS_dztauid,OBS_tempid               ! input variable ID in files
216
217real,dimension(:,:,:,:),allocatable :: out_dztau,OBS_dztau ! the 4D dust opacities from outfile and obsfile
218real,dimension(:,:,:,:),allocatable :: OBS_temp            ! temperature from obsfile
219
220real,dimension(:),allocatable :: OBS_plev ! pressure levels encompassing each Observer pressure levels
221
222real :: OBS_rho              ! temporary OBS atm density computed from OBS temp and pressure
223real,parameter :: r_atm=191. ! Mars atmosphere specific gas constant
224real,parameter :: g=3.72     ! Mars gravity
225real :: out_tau,OBS_tau      ! integrated dust columns from GCM (outfile) and OBS
226
227real,dimension(:,:,:),allocatable :: tau_ratio ! ratio out_tau/OBS_tau
228
229
230!===================================================================================
231! 1. OPENING OF THE FILES AND INITIALIZATION OF THE DIMENSIONS
232!===================================================================================
233write(*,*) "Welcome in the MRO/MCS Observer Simulator program !"
234!===============================================================================
235! 1.1 MCS data file : obsfile
236!===============================================================================
237!================================================================
238! 1.1.1 Open the Observer data file
239!================================================================
240! Ask the user to give a netcdf observation file
241WRITE(*,*) "-> Enter observation file name :"
242READ(*,*) obsfile
243
244status=NF90_OPEN(obsfile,nf90_nowrite,obsfid) ! nowrite mode=the program can only read the opened file
245error_text="Error: could not open file "//trim(obsfile)
246call status_check(status,error_text)
247
248!================================================================
249! 1.1.2 Get dimensions lon,lat,alt,time from the observation file
250!================================================================
251! OBS Latitude
252!--------------
253status=nf90_inq_dimid(obsfid,"latitude",lat_dimid_obs)
254error_text="Failed to find Observer latitude dimension"
255call status_check(status,error_text)
256
257status=nf90_inquire_dimension(obsfid,lat_dimid_obs,len=OBSlatlen)
258error_text="Failed to find Observer latitude length"
259call status_check(status,error_text)
260allocate(OBSlat(OBSlatlen))
261
262status=nf90_inq_varid(obsfid,"latitude",OBSvarid)
263error_text="Failed to find Observer latitude ID"
264call status_check(status,error_text)
265
266! Read OBSlat
267status=NF90_GET_VAR(obsfid,OBSvarid,OBSlat)
268error_text="Failed to load OBSlat"
269call status_check(status,error_text)
270
271
272! OBS Longitude
273!--------------
274status=nf90_inq_dimid(obsfid,"longitude",lon_dimid_obs)
275error_text="Failed to find Observer longitude dimension"
276call status_check(status,error_text)
277
278status=nf90_inquire_dimension(obsfid,lon_dimid_obs,len=OBSlonlen)
279error_text="Failed to find Observer longitude length"
280call status_check(status,error_text)
281allocate(OBSlon(OBSlonlen))
282
283status=nf90_inq_varid(obsfid,"longitude",OBSvarid)
284error_text="Failed to find Observer longitude ID"
285call status_check(status,error_text)
286
287! Read OBSlon
288status=NF90_GET_VAR(obsfid,OBSvarid,OBSlon)
289error_text="Failed to load OBSlon"
290call status_check(status,error_text)
291
292
293! OBS Time (Ls)
294!--------------
295status=nf90_inq_dimid(obsfid,"time",time_dimid_obs)
296error_text="Failed to find Observer time (Ls) dimension"
297call status_check(status,error_text)
298
299status=nf90_inquire_dimension(obsfid,time_dimid_obs,len=OBSLslen)
300error_text="Failed to find Observer time (Ls) length"
301call status_check(status,error_text)
302allocate(OBSLs(OBSLslen))
303
304status=nf90_inq_varid(obsfid,"time",OBSvarid)
305error_text="Failed to find Observer time (Ls) ID"
306call status_check(status,error_text)
307
308! Read OBSLs
309status=NF90_GET_VAR(obsfid,OBSvarid,OBSLs)
310error_text="Failed to load OBSLs"
311call status_check(status,error_text)
312
313! Get the observation timestep between bins
314OBSdeltaLs=OBSLs(2)-OBSLs(1)
315
316
317! OBS Altitude
318!--------------
319status=nf90_inq_dimid(obsfid,"altitude",alt_dimid_obs)
320error_text="Failed to find Observer altitude dimension"
321call status_check(status,error_text)
322
323status=nf90_inquire_dimension(obsfid,alt_dimid_obs,len=OBSaltlen)
324error_text="Failed to find Observer altitude length"
325call status_check(status,error_text)
326allocate(OBSalt(OBSaltlen))
327
328status=nf90_inq_varid(obsfid,"altitude",OBSvarid)
329error_text="Failed to find Observer altitude ID"
330call status_check(status,error_text)
331
332! Read OBSalt
333status=NF90_GET_VAR(obsfid,OBSvarid,OBSalt)
334error_text="Failed to load OBSalt"
335call status_check(status,error_text)
336
337! Check altitude attribute "units" to find out altitude type and compare with the GCM file
338status=nf90_get_att(obsfid,OBSvarid,"units",units)
339error_text="Failed to load Observer altitude units attribute"
340call status_check(status,error_text)
341! an unknown and invisible character is placed just after the unit's
342! characters in the Observer file so we only take the first characters
343! corresponding to the sought unit
344if (trim(units(1:2)).eq."Pa") then
345  units="Pa"
346  OBSalttype='p' ! pressure coordinate
347else if (trim(units(1:2)).eq."m") then
348  units="m"
349  OBSalttype='z' ! altitude coordinate
350else
351  write(*,*)" I do not understand this unit ",trim(units)," for Observer altitude!"
352  stop
353endif
354
355!===============================================================================
356! 1.2. GCM simulation file : gcmfile
357!===============================================================================
358!================================================================
359! 1.2.1 Open the GCM simulation file
360!================================================================
361! Ask the user to give a netcdf input file
362write(*,*)"";WRITE(*,*) "-> Enter input file name (GCM simulation) :"
363READ(*,*) gcmfile
364
365! Open GCM file
366status=NF90_OPEN(gcmfile,nf90_nowrite,gcmfid)
367! nowrite mode=the program can only read the opened file
368error_text="Failed to open datafile "//trim(gcmfile)
369call status_check(status,error_text)
370
371!================================================================
372! 1.2.2 Get dimensions lon,lat,alt,time from the GCM file
373!================================================================
374! GCM Latitude
375!--------------
376status=nf90_inq_dimid(gcmfid,"latitude",lat_dimid_gcm)
377error_text="Failed to find GCM latitude dimension"
378call status_check(status,error_text)
379
380status=nf90_inquire_dimension(gcmfid,lat_dimid_gcm,len=GCMlatlen)
381error_text="Failed to find GCM latitude length"
382call status_check(status,error_text)
383allocate(GCMlat(GCMlatlen))
384
385status=nf90_inq_varid(gcmfid,"latitude",GCMvarid)
386error_text="Failed to find GCM latitude ID"
387call status_check(status,error_text)
388
389! Read GCMlat
390status=NF90_GET_VAR(gcmfid,GCMvarid,GCMlat)
391error_text="Failed to load GCMlat"
392call status_check(status,error_text)
393
394
395! GCM Longitude
396!--------------
397status=nf90_inq_dimid(gcmfid,"longitude",lon_dimid_gcm)
398error_text="Failed to find GCM longitude dimension"
399call status_check(status,error_text)
400
401status=nf90_inquire_dimension(gcmfid,lon_dimid_gcm,len=GCMlonlen)
402error_text="Failed to find GCM longitude length"
403call status_check(status,error_text)
404allocate(GCMlon(GCMlonlen))
405
406status=nf90_inq_varid(gcmfid,"longitude",GCMvarid)
407error_text="Failed to find GCM longitude ID"
408call status_check(status,error_text)
409
410! Read GCMlon
411status=NF90_GET_VAR(gcmfid,GCMvarid,GCMlon)
412error_text="Failed to load GCMlon"
413call status_check(status,error_text)
414
415
416! GCM Time
417!--------------
418status=nf90_inq_dimid(gcmfid,"Time",time_dimid_gcm)
419error_text="Failed to find GCM time dimension"
420call status_check(status,error_text)
421
422status=nf90_inquire_dimension(gcmfid,time_dimid_gcm,len=GCMtimelen)
423error_text="Failed to find GCM time length"
424call status_check(status,error_text)
425allocate(GCMtime(GCMtimelen))
426
427status=nf90_inq_varid(gcmfid,"Time",GCMvarid)
428error_text="Failed to find GCM time ID"
429call status_check(status,error_text)
430
431status=NF90_GET_VAR(gcmfid,GCMvarid,GCMtime)
432error_text="Failed to load GCMtime"
433call status_check(status,error_text)
434
435! is_stats ?
436IF ((GCMtimelen.eq.12).and.(GCMtime(1).eq.2.).and.(GCMtime(GCMtimelen).eq.24.)) then
437  ! if GCM file is a stats, time is in LT at longitude 0° and not in sols at longitude 0°
438  write(*,*)"The GCM file is recognized as a stats file."
439  is_stats = .true.
440  deallocate(GCMtime)
441  GCMstatstimelen = GCMtimelen
442  allocate(GCMstatstime(GCMstatstimelen))
443  status=NF90_GET_VAR(gcmfid,GCMvarid,GCMstatstime)
444  error_text="Failed to load GCMstatstime (LT at lon 0)"
445  call status_check(status,error_text)
446ELSE
447  write(*,*)"The GCM file is recognized as a diagfi/concatnc file."
448ENDIF
449
450! Simulation time offset management
451WRITE(*,*) "Beginning date of the simulation file?"
452WRITE(*,*) "(i.e. number of sols since Ls=0 at the Time=0.0 in the GCM file)"
453READ(*,*) starttimeoffset
454if (.not.is_stats) then
455  ! Add the offset to GCMtime(:) if the file is not a stats file
456  GCMtime(:)=GCMtime(:)+starttimeoffset
457endif
458
459! Check of temporal coherence between gcmfile & obsfile
460call ls2sol(OBSLs(OBSLslen),maxsol) ! maximum date considered
461call ls2sol(OBSLs(1),minsol) ! minimum date considered
462
463IF (.not.is_stats) then ! if it is a diagfi, we check the time coherence between the 2 files
464  if ((maxsol.gt.maxval(GCMtime)).or.(minsol.lt.minval(GCMtime))) then
465    write(*,*)"Error : obsfile temporal bounds exceed the GCM simulation bounds."
466    write(*,*)"Please use a GCM file whose time interval contains the observation period."
467    stop
468  else
469    write(*,*)"Both files are temporally coherent. The program continues..."
470  endif
471
472ELSE ! if it is a stats, we create the array GCMtime array (in sols) covering the observation period
473     ! and filled with the mean GCM day stored in stats.nc
474
475  GCMtimelen = ((ceiling(maxsol)-floor(minsol)+1)+2) ! we add 2 days in the beginning and the end
476                                                     ! to be sure we cover the observation period
477  allocate(GCMtime(GCMstatstimelen * GCMtimelen))
478  do l=1,GCMtimelen
479    do m=1,GCMstatstimelen
480      GCMtime(m+(l-1)*GCMstatstimelen) = (floor(minsol)-1) + (l-1) + GCMstatstime(m)/24.
481    enddo
482  enddo
483  GCMtimelen = GCMstatstimelen * GCMtimelen
484  write(*,*)"GCMtime has been created from the stats.nc time and the observation period. The program continues..."
485ENDIF
486
487
488! GCM Altitude
489!--------------
490status=nf90_inq_dimid(gcmfid,"altitude",alt_dimid_gcm)
491error_text="Failed to find GCM altitude dimension"
492call status_check(status,error_text)
493
494status=nf90_inquire_dimension(gcmfid,alt_dimid_gcm,len=GCMaltlen)
495error_text="Failed to find GCM altitude length"
496call status_check(status,error_text)
497allocate(GCMalt(GCMaltlen))
498
499status=nf90_inq_varid(gcmfid,"altitude",GCMvarid)
500error_text="Failed to find GCM altitude ID"
501call status_check(status,error_text)
502
503! Read GCMalt
504status=NF90_GET_VAR(gcmfid,GCMvarid,GCMalt)
505error_text="Failed to load GCMalt"
506call status_check(status,error_text)
507
508! Check altitude attribute "units" to find out altitude type
509status=nf90_get_att(gcmfid,GCMvarid,"units",units)
510error_text="Failed to load GCM altitude units attribute"
511call status_check(status,error_text)
512if (trim(units).eq."Pa") then
513  GCMalttype='p' ! pressure coordinate
514else if (trim(units).eq."m") then
515  GCMalttype='z' ! altitude coordinate
516else
517  write(*,*)"I do not understand this unit ",trim(units)," for GCM altitude!"
518  if (OBSalttype.eq.'p') then
519    write(*,*)"Please use zrecast to put the altitude in the same type as the MCS file (pressure in Pa)"
520  else if (OBSalttype.eq.'z') then
521    write(*,*)"Please use zrecast to put the altitude in the same type as the MCS file (altitude in m)"
522  endif
523  stop
524endif
525IF(OBSalttype.ne.GCMalttype) then
526  write(*,*)"Observer altitude type (", OBSalttype,") and ", &
527            "GCM altitude type (",GCMalttype,") don't match!"
528  stop
529ENDIF
530
531!===============================================================================
532! 1.3 Create the output file & initialize the coordinates
533!===============================================================================
534! Name of the outfile
535IF (.not.is_stats) then
536  outfile=obsfile(1:index(obsfile, ".nc")-1)//"_GCMdiagfi.nc"
537ELSE
538  outfile=obsfile(1:index(obsfile, ".nc")-1)//"_GCMstats.nc"
539ENDIF
540
541! Creation of the outfile
542status=NF90_CREATE(outfile,nf90_clobber,outfid)!NB: clobber mode=overwrite any dataset with the same file name !
543error_text="Error: could not create file "//trim(outfile)
544call status_check(status,error_text)
545write(*,*)"";WRITE(*,*)"-> Output file is: ",trim(outfile)
546
547! Creation of the dimensions
548call inidim(outfid,OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen,OBSlon,OBSlat,OBSalt,OBSLs,OBSalttype,&
549            lon_dimid_obs,lat_dimid_obs,alt_dimid_obs,time_dimid_obs)
550
551!write(*,*)"Dimensions ID in the outfile are :"           
552!write(*,*)"lon_dimid=",lon_dimid_obs
553!write(*,*)"lat_dimid=",lat_dimid_obs
554!write(*,*)"alt_dimid=",alt_dimid_obs
555!write(*,*)"time_dimid=",time_dimid_obs
556
557
558
559!===================================================================================
560! 2. VARIABLES MANAGEMENT
561!===================================================================================
562!===============================================================================
563! 2.1 List of the GCM variables to be interpolated
564!===============================================================================
565!================================================================
566! 2.1.1 Read the GCM variables
567!================================================================
568! Initialize logicals
569dustok1 = .false.
570dustok2 = .false.
571dustok3 = .false.
572wiceok = .false.
573
574! Get nbvarfile (total number of variables in the GCM file)
575status=NF90_INQUIRE(gcmfid,nVariables=nbvarfile)
576error_text="Error : Pb with nf90_inquire(gcmfid,nVariables=nbvarfile)"
577call status_check(status,error_text)
578
579! List of variables that should not be processed
580notprocessed(1)='Time'
581notprocessed(2)='controle'
582notprocessed(3)='rlonu'
583notprocessed(4)='latitude'
584notprocessed(5)='longitude'
585notprocessed(6)='altitude'
586notprocessed(7)='rlatv'
587notprocessed(8)='aps'
588notprocessed(9)='bps'
589notprocessed(10)='ap'
590notprocessed(11)='bp'
591notprocessed(12)='cu'
592notprocessed(13)='cv'
593notprocessed(14)='aire'
594notprocessed(15)='phisinit'
595
596
597! List of variables in the GCM file
598write(*,*)""
599write(*,*)"List of variables in the GCM file :"
600Nnotprocessed=0
601do v=1,nbvarfile
602  status=NF90_INQUIRE_VARIABLE(gcmfid,v,name=GCMvarname)
603  ! GCMvarname now contains the "name" of variable of ID # v
604  var_ok=.true.
605  do vnot=1,15
606    if (GCMvarname.eq.notprocessed(vnot)) then
607      var_ok=.false.
608      Nnotprocessed=Nnotprocessed+1
609    endif
610  enddo       
611  if (var_ok) write(*,*) trim(GCMvarname)
612 
613  ! Detect if we can compute dust and wice opacities
614  if (trim(GCMvarname).eq."dso") then
615    dustok1 = .true.
616  else if (trim(GCMvarname).eq."dsodust") then
617    dustok2 = .true.
618  else if (trim(GCMvarname).eq."dustq") then
619    dustok3 = .true.
620  else if (trim(GCMvarname).eq."h2o_ice") then
621    wiceok = .true.
622  endif
623enddo
624
625! Nnotprocessed: # of variables that won't be processed
626! nbvarfile: total # of variables in file
627! +2: the dust and wice opacities
628allocate(gcm_vars(nbvarfile-Nnotprocessed+2),stat=status)
629if (status.ne.0) then
630  write(*,*) "Error: failed allocation of gcm_vars(nbvarfile-Nnotprocessed+2)"
631  write(*,*) "  nbvarfile=",nbvarfile
632  write(*,*) "  Nnotprocessed=",Nnotprocessed
633  stop
634endif
635
636! List of variables to process
637write(*,*)
638write(*,*) "Which variables do you want to redistribute ?"
639write(*,*) "list of <variables> (separated by <Return>s)"
640write(*,*) "(an empty line , i.e: just <Return>, implies end of list)"
641write(*,*) "NB: this program handles only 4D netcdf variables for now"
642nbvar=0
643read(*,'(a50)') GCMvarname
644do while ((GCMvarname.ne.' ').AND.(trim(GCMvarname).ne."all"))
645  nbvar=nbvar+1
646  gcm_vars(nbvar)=GCMvarname
647  read(*,'(a50)') GCMvarname
648enddo
649
650if (GCMvarname.eq."all") then
651  nbvar=nbvarfile-Nnotprocessed
652  do v=Nnotprocessed+1,nbvarfile
653    status=nf90_inquire_variable(gcmfid,v,name=gcm_vars(v-Nnotprocessed))
654  enddo
655! Variables names from the file are stored in gcm_vars()
656  nbvar=nbvarfile-Nnotprocessed
657  do v=1,nbvar
658    status=nf90_inquire_variable(gcmfid,v+Nnotprocessed,name=gcm_vars(v))
659    write(*,'(a9,1x,i2,1x,a1,1x,a64)') "variable ",v,":",gcm_vars(v)
660  enddo
661else if(nbvar==0) then
662  write(*,*) "No variables to process in the GCM file... program stopped"
663  stop
664endif ! of if (GCMvarname.eq."all")
665
666!================================================================
667! 2.1.2 Handle dust and wice opacities (first set-ups)
668!================================================================
669! 2nd part is in section 2.4.2
670write(*,*)
671! Load atmospheric density "rho"
672if (dustok1.or.dustok2.or.dustok3.or.wiceok) then
673  ! Check that the GCM file contains that variable
674  status=nf90_inq_varid(gcmfid,"rho",GCMvarid)
675  if (status.ne.nf90_noerr) then
676    write(*,*) "Failed to find variable rho in "//trim(gcmfile)
677    write(*,*) "No computation of opacities..."
678    dustok1 =.false.
679    dustok2 =.false.
680    dustok3 =.false.
681    wiceok  =.false.
682  else
683    ! Length allocation for each dimension of the 4D variable
684    allocate(GCM_rho(GCMlonlen,GCMlatlen,GCMaltlen,GCMtimelen))
685
686    ! Load datasets
687    if (.not.is_stats) then
688      status=NF90_GET_VAR(gcmfid,GCMvarid,GCM_rho)
689      error_text="Failed to load rho"
690      call status_check(status,error_text)
691    else
692      ! if it is a stats file, we load only the first sol, and then copy it to all the other sols
693      status=NF90_GET_VAR(gcmfid,GCMvarid,GCM_rho(:,:,:,1:GCMstatstimelen))
694      error_text="Failed to load rho"
695      call status_check(status,error_text)
696    !  write(*,*)"GCMstatstimelen = ", GCMstatstimelen
697    !  write(*,*)"GCMtimelen = ", GCMtimelen
698      do l=(GCMstatstimelen+1),GCMtimelen
699        if (modulo(l,GCMstatstimelen).ne.0) then
700          GCM_rho(:,:,:,l) = GCM_rho(:,:,:,modulo(l,GCMstatstimelen))
701        else ! if l is a multiple of GCMstatstimelen, since the index modulo(l,GCMstatstimelen)=0
702             ! doesn't exist, we make a special case
703          GCM_rho(:,:,:,l) = GCM_rho(:,:,:,GCMstatstimelen)
704        endif
705      enddo
706    endif
707    write(*,*) "Variable rho loaded from the GCM file"
708  endif
709endif ! dustok1.or.dustok2.or.dustok3.or.wiceok
710
711! Dust and wice opacity booleans
712if (dustok1.or.dustok2.or.dustok3) then
713  nbvar=nbvar+1
714  gcm_vars(nbvar)="dust"
715endif
716
717if (wiceok) then
718  nbvar=nbvar+1
719  gcm_vars(nbvar)="wice"
720endif
721
722!write(*,*) "gcm_vars retrieved : ",gcm_vars(1:nbvar)
723
724!===============================================================================
725! 2.2 Definition of LT variables from obsfile to outfile
726!===============================================================================
727! --> the day/night loop begins here
728
729!******************** NOTA BENE (cf sections 2.2 and 4)*************************
730! We execute the program a first time with the daytime values, and then a second
731! time with the nighttime values.
732!*******************************************************************************
733
734dayornight = "dayside" ! we begin with daytime temperature
735write(*,*)"" ; write(*,*) "Beginning the 1st loop, on daytime values"; write(*,*)""
736DAY_OR_NIGHT: DO ! (the end of the loop is in section 4.)
737
738  SELECT CASE (dayornight)
739  CASE ("dayside")
740    OBSLTave_name = "dtimeave"
741    OBSLTmax_name = "dtimemax"
742    OBSLTmin_name = "dtimemin"
743  CASE ("nightside")
744    OBSLTave_name = "ntimeave"
745    OBSLTmax_name = "ntimemax"
746    OBSLTmin_name = "ntimemin"
747  END SELECT
748
749!================================================================
750! 2.2.1 Average of Local Time in the OBS bins
751!================================================================
752  ! Read the OBS file
753  !------------------
754  status=nf90_inq_varid(obsfid,trim(OBSLTave_name),LT_id)
755  error_text="Failed to find Observer local time ("//trim(OBSLTave_name)//") ID in "//trim(obsfile)
756  call status_check(status,error_text)
757  status=nf90_inquire_variable(obsfid,LT_id,dimids=LTshape)
758  error_text="Failed to get the dim shape of variable "//trim(OBSLTave_name)
759  call status_check(status,error_text)
760 
761  ! Length allocation for each dimension of the 3D variable
762  allocate(OBSLT(OBSlonlen,OBSlatlen,OBSLslen))
763 
764  ! Load datasets
765  status=NF90_GET_VAR(obsfid,LT_id,OBSLT)
766  error_text="Failed to load "//trim(OBSLTave_name)//" from the obsfile"
767  call status_check(status,error_text)
768  write(*,*) trim(OBSLTave_name)," loaded from the obsfile"
769 
770  ! Get LT missing_value attribute
771  status=nf90_get_att(obsfid,LT_id,"_FillValue",LTmiss_val)
772  error_text="Failed to load missing_value attribute"
773  call status_check(status,error_text)
774
775  ! Create the variable in the outfile
776  !-----------------------------------
777  ! Switch to netcdf define mode
778  status=nf90_redef(outfid)
779  error_text="Error: could not switch to define mode in the outfile"
780  call status_check(status,error_text)
781 
782  ! Definition of the variable
783  status=NF90_DEF_VAR(outfid,trim(OBSLTave_name),nf90_float,LTshape,LT_id)
784  error_text="Error: could not define the variable "//trim(OBSLTave_name)//" in the outfile"
785  call status_check(status,error_text)
786 
787  ! Write the attributes
788  select case (dayornight)
789  case ("dayside")
790    status=nf90_put_att(outfid,LT_id,"long_name","Average local time in bin - day side [6h, 18h]")
791  case ("nightside")
792    status=nf90_put_att(outfid,LT_id,"long_name","Average local time in bin - night side [18h, 6h]")
793  end select
794  status=nf90_put_att(outfid,LT_id,"units","hours")
795  status=nf90_put_att(outfid,LT_id,"_FillValue",LTmiss_val)
796 
797  ! End the netcdf define mode (and thus enter the "data writing" mode)
798  status=nf90_enddef(outfid)
799  error_text="Error: could not close the define mode of the outfile"
800  call status_check(status,error_text)
801 
802  ! Write the data in the output file
803  status = NF90_PUT_VAR(outfid, LT_id, OBSLT) ! write the MCS d/ntimeave as the output Local Time
804  error_text="Error: could not write "//trim(OBSLTave_name)//" data in the outfile"
805  call status_check(status,error_text)
806
807  write(*,*)"Local Time (",trim(OBSLTave_name),") has been created in the outfile"
808  write(*,'("  with missing_value attribute : ",1pe12.5)')LTmiss_val
809
810!================================================================
811! 2.2.2 Maximum of Local Time in the OBS bins
812!================================================================
813  ! Read the OBS file
814  !------------------
815  status=nf90_inq_varid(obsfid,trim(OBSLTmax_name),LT_id)
816  error_text="Failed to find Observer max local time ("//trim(OBSLTmax_name)//") ID in "//trim(obsfile)
817  call status_check(status,error_text)
818  status=nf90_inquire_variable(obsfid,LT_id,dimids=LTshape)
819  error_text="Failed to get the dim shape of variable "//trim(OBSLTmax_name)
820  call status_check(status,error_text)
821 
822  ! Length allocation for each dimension of the 3D variable
823  allocate(OBSLTmax(OBSlonlen,OBSlatlen,OBSLslen))
824 
825  ! Load datasets
826  status=NF90_GET_VAR(obsfid,LT_id,OBSLTmax)
827  error_text="Failed to load "//trim(OBSLTmax_name)//" from the obsfile"
828  call status_check(status,error_text)
829  write(*,*) trim(OBSLTmax_name)," loaded from the obsfile"
830
831!================================================================
832! 2.2.3 Minimum of Local Time in the OBS bins
833!================================================================
834  ! Read the OBS file
835  !------------------
836  status=nf90_inq_varid(obsfid,trim(OBSLTmin_name),LT_id)
837  error_text="Failed to find Observer min local time ("//trim(OBSLTmin_name)//") ID in "//trim(obsfile)
838  call status_check(status,error_text)
839  status=nf90_inquire_variable(obsfid,LT_id,dimids=LTshape)
840  error_text="Failed to obtain information on variable "//trim(OBSLTmin_name)
841  call status_check(status,error_text)
842
843  ! Length allocation for each dimension of the 3D variable
844  allocate(OBSLTmin(OBSlonlen,OBSlatlen,OBSLslen))
845 
846  ! Load datasets
847  status=NF90_GET_VAR(obsfid,LT_id,OBSLTmin)
848  error_text="Failed to load "//trim(OBSLTmin_name)//" from the obsfile"
849  call status_check(status,error_text)
850  write(*,*) trim(OBSLTmin_name)," loaded from the obsfile"
851  write(*,*)""
852
853!===============================================================================
854! 2.3 Definition of numbin variables from obsfile to outfile
855!===============================================================================
856!================================================================
857! 2.3.1 Number of values in the OBS "temp" bins
858!================================================================
859  SELECT CASE (dayornight)
860  CASE ("dayside")
861    numbin_name = "dnumbintemp"
862  CASE ("nightside")
863    numbin_name = "nnumbintemp"
864  END SELECT
865 
866  ! Read the OBS file
867  !------------------
868  status=nf90_inq_varid(obsfid,trim(numbin_name),numbin_id)
869  error_text="Failed to find Observer nb of temp values in bin ("//trim(numbin_name)//")'s ID in "//trim(obsfile)
870  call status_check(status,error_text)
871  status=nf90_inquire_variable(obsfid,numbin_id,dimids=numbinshape)
872  error_text="Failed to obtain information on variable "//trim(numbin_name)
873  call status_check(status,error_text)
874 
875  ! Length allocation for each dimension of the 4D variable
876  allocate(numbin(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
877 
878  ! Load datasets
879  status=NF90_GET_VAR(obsfid,numbin_id,numbin)
880  error_text="Failed to load "//trim(numbin_name)//" from the obsfile"
881  call status_check(status,error_text)
882  write(*,*) trim(numbin_name)," loaded from the obsfile"
883
884  ! Create the variable in the outfile
885  !-----------------------------------
886  ! Switch to netcdf define mode
887  status=nf90_redef(outfid)
888  error_text="Error: could not switch to define mode in the outfile"
889  call status_check(status,error_text)
890 
891  ! Definition of the variable
892  status=NF90_DEF_VAR(outfid,trim(numbin_name),nf90_float,numbinshape,numbin_id)
893  error_text="Error: could not define the variable "//trim(numbin_name)//" in the outfile"
894  call status_check(status,error_text)
895 
896  ! Write the attributes
897  select case (dayornight)
898  case ("dayside")
899    status=nf90_put_att(outfid,numbin_id,"long_name","Number of temp values in bin - day side")
900  case ("nightside")
901    status=nf90_put_att(outfid,numbin_id,"long_name","Number of temp values in bin - night side")
902  end select
903
904  ! End the netcdf define mode (and thus enter the "data writing" mode)
905  status=nf90_enddef(outfid)
906  error_text="Error: could not close the define mode of the outfile"
907  call status_check(status,error_text)
908 
909  ! Write the data in the output file
910  status = NF90_PUT_VAR(outfid, numbin_id, numbin)
911  error_text="Error: could not write "//trim(numbin_name)//" data in the outfile"
912  call status_check(status,error_text)
913 
914  write(*,*)"Number of temp values in bin (",trim(numbin_name),") has been created in the outfile"
915  write(*,*)""
916  deallocate(numbin)
917
918!================================================================
919! 2.3.2 Number of values in the OBS "dust" bins
920!================================================================
921  SELECT CASE (dayornight)
922  CASE ("dayside")
923    numbin_name = "dnumbindust"
924  CASE ("nightside")
925    numbin_name = "nnumbindust"
926  END SELECT
927 
928  ! Read the OBS file
929  !------------------
930  status=nf90_inq_varid(obsfid,trim(numbin_name),numbin_id)
931  error_text="Failed to find Observer nb of dust values in bin ("//trim(numbin_name)//")'s ID in "//trim(obsfile)
932  call status_check(status,error_text)
933  status=nf90_inquire_variable(obsfid,numbin_id,dimids=numbinshape)
934  error_text="Failed to obtain information on variable "//trim(numbin_name)
935  call status_check(status,error_text)
936 
937  ! Length allocation for each dimension of the 4D variable
938  allocate(numbin(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
939 
940  ! Load datasets
941  status=NF90_GET_VAR(obsfid,numbin_id,numbin)
942  error_text="Failed to load "//trim(numbin_name)//" from the obsfile"
943  call status_check(status,error_text)
944  write(*,*) trim(numbin_name)," loaded from the obsfile"
945
946  ! Create the variable in the outfile
947  !-----------------------------------
948  ! Switch to netcdf define mode
949  status=nf90_redef(outfid)
950  error_text="Error: could not switch to define mode in the outfile"
951  call status_check(status,error_text)
952 
953  ! Definition of the variable
954  status=NF90_DEF_VAR(outfid,trim(numbin_name),nf90_float,numbinshape,numbin_id)
955  error_text="Error: could not define the variable "//trim(numbin_name)//" in the outfile"
956  call status_check(status,error_text)
957 
958  ! Write the attributes
959  select case (dayornight)
960  case ("dayside")
961    status=nf90_put_att(outfid,numbin_id,"long_name","Number of dust values in bin - day side")
962  case ("nightside")
963    status=nf90_put_att(outfid,numbin_id,"long_name","Number of dust values in bin - night side")
964  end select
965
966  ! End the netcdf define mode (and thus enter the "data writing" mode)
967  status=nf90_enddef(outfid)
968  error_text="Error: could not close the define mode of the outfile"
969  call status_check(status,error_text)
970 
971  ! Write the data in the output file
972  status = NF90_PUT_VAR(outfid, numbin_id, numbin)
973  error_text="Error: could not write "//trim(numbin_name)//" data in the outfile"
974  call status_check(status,error_text)
975 
976  write(*,*)"Number of dust values in bin (",trim(numbin_name),") has been created in the outfile"
977  write(*,*)""
978  deallocate(numbin)
979 
980!================================================================
981! 2.3.3 Number of values in the OBS "wice" bins
982!================================================================
983  SELECT CASE (dayornight)
984  CASE ("dayside")
985    numbin_name = "dnumbinwice"
986  CASE ("nightside")
987    numbin_name = "nnumbinwice"
988  END SELECT
989 
990  ! Read the OBS file
991  !------------------
992  status=nf90_inq_varid(obsfid,trim(numbin_name),numbin_id)
993  error_text="Failed to find Observer nb of wice values in bin ("//trim(numbin_name)//")'s ID in "//trim(obsfile)
994  call status_check(status,error_text)
995  status=nf90_inquire_variable(obsfid,numbin_id,dimids=numbinshape)
996  error_text="Failed to obtain information on variable "//trim(numbin_name)
997  call status_check(status,error_text)
998 
999  ! Length allocation for each dimension of the 4D variable
1000  allocate(numbin(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
1001 
1002  ! Load datasets
1003  status=NF90_GET_VAR(obsfid,numbin_id,numbin)
1004  error_text="Failed to load "//trim(numbin_name)//" from the obsfile"
1005  call status_check(status,error_text)
1006  write(*,*) trim(numbin_name)," loaded from the obsfile"
1007
1008  ! Create the variable in the outfile
1009  !-----------------------------------
1010  ! Switch to netcdf define mode
1011  status=nf90_redef(outfid)
1012  error_text="Error: could not switch to define mode in the outfile"
1013  call status_check(status,error_text)
1014 
1015  ! Definition of the variable
1016  status=NF90_DEF_VAR(outfid,trim(numbin_name),nf90_float,numbinshape,numbin_id)
1017  error_text="Error: could not define the variable "//trim(numbin_name)//" in the outfile"
1018  call status_check(status,error_text)
1019 
1020  ! Write the attributes
1021  select case (dayornight)
1022  case ("dayside")
1023    status=nf90_put_att(outfid,numbin_id,"long_name","Number of wice values in bin - day side")
1024  case ("nightside")
1025    status=nf90_put_att(outfid,numbin_id,"long_name","Number of wice values in bin - night side")
1026  end select
1027
1028  ! End the netcdf define mode (and thus enter the "data writing" mode)
1029  status=nf90_enddef(outfid)
1030  error_text="Error: could not close the define mode of the outfile"
1031  call status_check(status,error_text)
1032 
1033  ! Write the data in the output file
1034  status = NF90_PUT_VAR(outfid, numbin_id, numbin)
1035  error_text="Error: could not write "//trim(numbin_name)//" data in the outfile"
1036  call status_check(status,error_text)
1037 
1038  write(*,*)"Number of wice values in bin (",trim(numbin_name),") has been created in the outfile"
1039  write(*,*)""
1040  deallocate(numbin)
1041
1042
1043!===============================================================================
1044! 2.4 Opening of the GCM variables
1045!===============================================================================
1046! --> the var loop begins here
1047
1048  VAR: DO v=1,nbvar ! LOOP ON ALL THE GCM VARIABLES TO PROCESS
1049                    ! (the end of the loop is in section 3.4)
1050   
1051    GCMvarname = gcm_vars(v)
1052   
1053    ! Detect the dust and wice opacities special cases         
1054    if (trim(GCMvarname).eq."dust") then
1055      ! Default : dso > dsodust > dustq
1056      if (dustok1) then ! "dso" is detected in gcmfile
1057        GCMvarname="dso"
1058        dustok2=.false.
1059        dustok3=.false.
1060      else if (dustok2) then ! "dsodust" is detected in gcmfile
1061        GCMvarname="dsodust"
1062        dustok3=.false.
1063      else if (dustok3) then ! "dustq" is detected in gcmfile
1064        GCMvarname="dustq"
1065      endif
1066      write(*,*) "Computing dust opacity..."
1067    endif
1068   
1069    if (trim(GCMvarname).eq."wice") then ! "h2o_ice" detected in gcmfile
1070      GCMvarname="h2o_ice"
1071      write(*,*) "Computing water ice opacity..."
1072    endif
1073
1074!================================================================
1075! 2.4.1 Generic reading of the variable
1076!================================================================
1077    ! Check that the GCM file contains that variable
1078    status=nf90_inq_varid(gcmfid,trim(GCMvarname),GCMvarid)
1079    if (status.ne.nf90_noerr) then
1080      write(*,*) "Failed to find variable "//trim(GCMvarname)//" in "//trim(gcmfile)
1081      write(*,*) "We'll skip that variable..."
1082      CYCLE VAR ! go directly to the next variable
1083    endif
1084
1085    ! Sanity checks on the variable
1086    status=nf90_inquire_variable(gcmfid,GCMvarid,ndims=nbdim,dimids=GCMvarshape)
1087    error_text="Failed to obtain information on variable "//trim(GCMvarname)
1088    call status_check(status,error_text)
1089
1090    ! Check that it is a 4D variable
1091    if (nbdim.ne.4) then
1092      write(*,*) "Error:",trim(GCMvarname)," is not a 4D variable"
1093      write(*,*) "We'll skip that variable...";write(*,*)""
1094      CYCLE VAR ! go directly to the next variable
1095    endif
1096    ! Check that its dimensions are indeed lon,lat,alt,time (in the right order)
1097    if (GCMvarshape(1).ne.lon_dimid_gcm) then
1098      write(*,*) "Error, expected first dimension of ",trim(GCMvarname)," to be longitude!"
1099      write(*,*) "We'll skip that variable..."
1100      CYCLE VAR ! go directly to the next variable
1101    endif
1102    if (GCMvarshape(2).ne.lat_dimid_gcm) then
1103      write(*,*) "Error, expected second dimension of ",trim(GCMvarname)," to be latitude!"
1104      write(*,*) "We'll skip that variable..."
1105      CYCLE VAR ! go directly to the next variable
1106    endif
1107    if (GCMvarshape(3).ne.alt_dimid_gcm) then
1108      write(*,*) "Error, expected third dimension of ",trim(GCMvarname)," to be altitude!"
1109      write(*,*) "We'll skip that variable..."
1110      CYCLE VAR ! go directly to the next variable
1111    endif
1112    if (GCMvarshape(4).ne.time_dimid_gcm) then
1113      write(*,*) "Error, expected fourth dimension of ",trim(GCMvarname)," to be time!"
1114      write(*,*) "We'll skip that variable..."
1115      CYCLE VAR ! go directly to the next variable
1116    endif
1117
1118    ! Length allocation for each dimension of the 4D variable
1119    allocate(GCM_var(GCMlonlen,GCMlatlen,GCMaltlen,GCMtimelen))
1120
1121    ! Load datasets
1122    if (.not.is_stats) then
1123      status=NF90_GET_VAR(gcmfid,GCMvarid,GCM_var)
1124      error_text="Failed to load "//trim(GCMvarname)
1125      call status_check(status,error_text)
1126    else
1127      ! if it is a stats file, we load only the first sol, and then copy it to all the other sols
1128      status=NF90_GET_VAR(gcmfid,GCMvarid,GCM_var(:,:,:,1:GCMstatstimelen))
1129      error_text="Failed to load "//trim(GCMvarname)
1130      call status_check(status,error_text)
1131    !  write(*,*)"GCMstatstimelen = ", GCMstatstimelen
1132    !  write(*,*)"GCMtimelen = ", GCMtimelen
1133      do l=(GCMstatstimelen+1),GCMtimelen
1134        if (modulo(l,GCMstatstimelen).ne.0) then
1135          GCM_var(:,:,:,l) = GCM_var(:,:,:,modulo(l,GCMstatstimelen))
1136        else ! if l is a multiple of GCMstatstimelen, since the index modulo(l,GCMstatstimelen)=0
1137             ! doesn't exist, we make a special case
1138          GCM_var(:,:,:,l) = GCM_var(:,:,:,GCMstatstimelen)
1139        endif
1140      enddo
1141    endif
1142    write(*,*) "Variable ",trim(GCMvarname)," loaded from the GCM file"
1143
1144    ! Get dataset's missing_value attribute
1145    status=nf90_get_att(gcmfid,GCMvarid,"missing_value",GCMmiss_val)
1146    error_text="Failed to load missing_value attribute"
1147    call status_check(status,error_text)
1148
1149    ! Get other variable's attributes
1150    status=nf90_get_att(gcmfid,GCMvarid,"long_name",long_name)
1151    if (status.ne.nf90_noerr) then
1152    ! if no attribute "long_name", try "title"
1153      status=nf90_get_att(gcmfid,GCMvarid,"title",long_name)
1154    endif
1155    status=nf90_get_att(gcmfid,GCMvarid,"units",units)
1156
1157!================================================================
1158! 2.4.2 Handle dust and wice opacities (second part)
1159!================================================================
1160    ! DUST
1161    !-----
1162    if (trim(gcm_vars(v)).eq."dust") then
1163
1164     IF (dustok1.or.dustok2) THEN
1165     ! Dust opacity computed from its density-scaled opacity
1166!       write(*,*)long_name(index(long_name,"(")+1:index(long_name,")")-1)
1167       do i=1,GCMlonlen
1168        do j=1,GCMlatlen
1169         do k=1,GCMaltlen
1170          do l=1,GCMtimelen
1171            if (GCM_var(i,j,k,l).ne.GCMmiss_val) then
1172              ! Multiply by rho to have opacity [1/km]
1173              GCM_var(i,j,k,l) = GCM_var(i,j,k,l) * GCM_rho(i,j,k,l) *1000.
1174
1175              if (long_name(index(long_name,"(")+1:index(long_name,")")-1).eq."TES") then
1176               ! The density-scaled opacity was calibrated on TES wavelength (9.3um)
1177               ! so we must recalibrate it to MCS wavelength (21.6um) using recalibration
1178               ! coefficients from Montabone et al. 2015, section 2.3
1179                GCM_var(i,j,k,l) = 1.3/2.7 * GCM_var(i,j,k,l)
1180              endif
1181            endif
1182          enddo
1183         enddo
1184        enddo
1185       enddo
1186
1187       long_name = "IR Dust opacity (from DSO)"
1188
1189     ELSE IF (dustok3) THEN
1190     ! Dust opacity computed from its mass mixing ratio
1191       do i=1,GCMlonlen
1192        do j=1,GCMlatlen
1193         do k=1,GCMaltlen
1194          do l=1,GCMtimelen
1195            if (GCM_var(i,j,k,l).ne.GCMmiss_val) then
1196              ! Opacity is computed from the equation of Heavens et al. 2014, section 2.3,
1197              ! assuming a rho_dust=3000 kg/m3 and an effective radius reff=1.06 microns
1198              ! + the opacity is here in 1/km and the MMR in kg/kg
1199              GCM_var(i,j,k,l) = GCM_var(i,j,k,l) * GCM_rho(i,j,k,l) / 0.012 * 1000
1200            endif
1201          enddo
1202         enddo
1203        enddo
1204       enddo
1205
1206       long_name = "IR Dust opacity (from MMR)"
1207
1208     ENDIF
1209   
1210     GCMvarname = gcm_vars(v) ! reput the right name in GCMvarname
1211     units = "opacity/km"
1212    endif ! trim(gcm_vars(v)).eq."dust"
1213   
1214   
1215    ! WICE
1216    !-----
1217    if (trim(gcm_vars(v)).eq."wice") then
1218    ! Water ice opacity computed from its mass mixing ratio
1219      do i=1,GCMlonlen
1220       do j=1,GCMlatlen
1221        do k=1,GCMaltlen
1222         do l=1,GCMtimelen
1223           if (GCM_var(i,j,k,l).ne.GCMmiss_val) then
1224             ! Opacity at MCS wavelength (11.9um) is computed from an equation
1225             ! similar to the one of Heavens et al. 2014, section 2.3.
1226             ! We assume a rho_wice=920 kg/m3, an effective radius reff=3um,
1227             ! an extinction coefficient Qext(wvl,reff)=1.54471
1228             GCM_var(i,j,k,l) = 750*1.54471* GCM_var(i,j,k,l) * GCM_rho(i,j,k,l) / (920*3e-6)
1229           endif
1230         enddo
1231        enddo
1232       enddo
1233      enddo
1234
1235      long_name = "IR Water ice opacity (from MMR)"
1236   
1237     GCMvarname = gcm_vars(v) ! reput the right name in GCMvarname
1238     units = "opacity/km"
1239    endif ! trim(gcm_vars(v)).eq."wice"
1240
1241!===============================================================================
1242! 2.5 Opening of the associated MCS variables
1243!===============================================================================
1244    ! Observer variables to extract :
1245    IF ((index(GCMvarname,"dust").ne.0).or.(index(GCMvarname,"dso").ne.0)) THEN
1246      ! if the variable name contains "dust" or "dso". Especially for the targeted variables :
1247      ! dustq,dustN,dsodust,reffdust,opadust, and their equivalents for stormdust & topdust
1248      OBSvarname  = "dust"
1249      numbin_name = "numbindust"
1250    ELSE IF ((trim(GCMvarname).eq."h2o_ice").or.(trim(GCMvarname).eq."wice") &
1251           .or.(trim(GCMvarname).eq."reffice").or.(trim(GCMvarname).eq."opawice")) THEN
1252      OBSvarname  = "wice"
1253      numbin_name = "numbinwice"
1254    ELSE ! default case is temp binning, since it contains the most values
1255      OBSvarname  = "temp"
1256      numbin_name = "numbintemp"
1257    ENDIF
1258   
1259    SELECT CASE (dayornight)
1260    CASE ("dayside")
1261      OBSvarname  = "d"//OBSvarname
1262      numbin_name = "d"//numbin_name
1263    CASE ("nightside")
1264      OBSvarname  = "n"//OBSvarname
1265      numbin_name = "n"//numbin_name
1266    END SELECT
1267   
1268!================================================================
1269! 2.5.1 MCS reference variable (for the missing values)
1270!================================================================   
1271    ! Check that the observation file contains that variable
1272    status=nf90_inq_varid(obsfid,trim(OBSvarname),OBSvarid)
1273    error_text="Failed to find variable "//trim(OBSvarname)//" in "//trim(obsfile)
1274    call status_check(status,error_text)
1275
1276    ! Sanity checks on the variable
1277    status=nf90_inquire_variable(obsfid,OBSvarid,ndims=nbdim,dimids=OBSvarshape)
1278    error_text="Failed to obtain information on variable "//trim(OBSvarname)
1279    call status_check(status,error_text)
1280
1281    ! Check that it is a 4D variable
1282    if (nbdim.ne.4) then
1283      write(*,*) "Error, expected a 4D (lon-lat-alt-time) variable for ",trim(OBSvarname)
1284      stop
1285    endif
1286    ! Check that its dimensions are indeed lon,lat,alt,time (in the right order)
1287    if (OBSvarshape(1).ne.lon_dimid_obs) then
1288      write(*,*) "Error, expected first dimension of ",trim(OBSvarname)," to be longitude!"
1289      stop
1290    endif
1291    if (OBSvarshape(2).ne.lat_dimid_obs) then
1292      write(*,*) "Error, expected second dimension of ",trim(OBSvarname)," to be latitude!"
1293      stop
1294    endif
1295    if (OBSvarshape(3).ne.alt_dimid_obs) then
1296      write(*,*) "Error, expected third dimension of ",trim(OBSvarname)," to be altitude!"
1297      stop
1298    endif
1299    if (OBSvarshape(4).ne.time_dimid_obs) then
1300      write(*,*) "Error, expected fourth dimension of ",trim(OBSvarname)," to be time!"
1301      stop
1302    endif
1303
1304    ! Length allocation for each dimension of the 4D variable
1305    allocate(OBS_var(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
1306
1307    ! Load datasets
1308    status=NF90_GET_VAR(obsfid,OBSvarid,OBS_var)
1309    error_text="Failed to load "//trim(OBSvarname)//" from the obsfile"
1310    call status_check(status,error_text)
1311    write(*,*) trim(OBSvarname)," loaded from the obsfile as reference variable"
1312
1313    ! Get OBS_var missing_value attribute
1314    status=nf90_get_att(obsfid,OBSvarid,"_FillValue",OBSmiss_val)
1315    error_text="Failed to load missing_value attribute"
1316    call status_check(status,error_text)
1317
1318!================================================================
1319! 2.5.2 Number of values in the OBS bin (for the sol binning)
1320!================================================================
1321    ! Check that the observation file contains that variable
1322    status=nf90_inq_varid(obsfid,trim(numbin_name),numbin_id)
1323
1324    ! Checks have already been done in section 2.3
1325   
1326    ! Length allocation for each dimension of the 4D variable
1327    allocate(numbin(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
1328
1329    ! Load datasets
1330    status=NF90_GET_VAR(obsfid,numbin_id,numbin)
1331   
1332!===============================================================================
1333! 2.6 Definition of GCM variables in outfile
1334!===============================================================================
1335    ! Switch to netcdf define mode
1336    status=nf90_redef(outfid)
1337    error_text="Error: could not switch to define mode in the outfile"
1338    call status_check(status,error_text)
1339
1340    ! Definition of the variable
1341    SELECT CASE (dayornight)
1342    CASE ("dayside")
1343      outvarname = "d"//GCMvarname
1344    CASE ("nightside")
1345      outvarname = "n"//GCMvarname
1346    END SELECT
1347    status=NF90_DEF_VAR(outfid,trim(outvarname),nf90_float,OBSvarshape,outvarid)
1348    error_text="Error: could not define the variable "//trim(outvarname)//" in the outfile"
1349    call status_check(status,error_text)
1350
1351    ! Write the attributes
1352    SELECT CASE (dayornight)
1353    CASE ("dayside")
1354      long_name = trim(long_name)//" - day side"
1355      status=nf90_put_att(outfid,outvarid,"long_name",long_name)
1356    CASE ("nightside")
1357      long_name = trim(long_name)//" - night side"
1358      status=nf90_put_att(outfid,outvarid,"long_name",long_name)
1359    END SELECT
1360    status=nf90_put_att(outfid,outvarid,"units",units)
1361    status=nf90_put_att(outfid,outvarid,"_FillValue",OBSmiss_val)
1362    comment = "Reference numbin: "//trim(numbin_name)
1363    status=nf90_put_att(outfid,outvarid,"comment",comment)
1364   
1365    write(*,*)trim(outvarname)," has been created in the outfile"
1366    write(*,'("  with missing_value attribute : ",1pe12.5)')OBSmiss_val
1367    write(*,*)""
1368   
1369    ! End the netcdf define mode (and thus enter the "data writing" mode)
1370    status=nf90_enddef(outfid)
1371    error_text="Error: could not close the define mode of the outfile"
1372    call status_check(status,error_text)
1373   
1374    allocate(outvar(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
1375
1376
1377!===================================================================================
1378! 3. EXTRACTION OF THE VARIABLE
1379!===================================================================================
1380!===============================================================================
1381! 3.1 Do some checks and preparations before the extraction
1382!===============================================================================
1383    Ls: do l=1,OBSLslen ! loop on all observed Solar longitudes
1384      Ls_val=OBSLs(l) ! Ls_val=center of the output bin
1385      if ((Ls_val.lt.0.).or.(Ls_val.gt.360.)) then
1386        write(*,*) "Unexpected value for OBSLs: ",Ls_val
1387        stop
1388      endif
1389
1390      ! Convert the Ls bin into a sol interval on which the binning is done :
1391      !----------------------------------------------------------------------
1392      !-> get the index of the maximum value of GCM sol (m_maxsol) that is lower than Ls bin's superior bound (maxsol)
1393      call ls2sol(Ls_val+OBSdeltaLs/2.,maxsol)
1394      m_maxsol=1
1395      do while (((GCMtime(m_maxsol)+0.5).lt.maxsol).AND.(m_maxsol.le.(GCMtimelen-1)))
1396    !! The +0.5 is there to take into account the whole planet (lon=[-180°;180°]) and not just the lon=0° from the GCM
1397        m_maxsol=m_maxsol+1
1398      enddo
1399      !-> get the index of the minimum value of GCM sol (m_minsol) that is greater than Ls bin's inferior bound (minsol)
1400      call ls2sol(Ls_val-OBSdeltaLs/2.,minsol)
1401      m_minsol=1
1402      do while (((GCMtime(m_minsol)-0.5).le.minsol).AND.(m_minsol.le.(GCMtimelen-1)))
1403    !! Same comment for the -0.5
1404        m_minsol=m_minsol+1
1405      enddo
1406      if (m_minsol.gt.m_maxsol) then
1407        write(*,*) "No value in gcmfile between sol=",minsol," and sol=",maxsol," (Ls=",Ls_val,"°)"
1408        ! Write a missing_value to output
1409        outvar(:,:,:,l) = OBSmiss_val
1410        CYCLE Ls ! go directly to the next Ls
1411      endif 
1412      ! Get all the integer values of GCM sols that fit in this interval
1413      solcount=floor(GCMtime(m_maxsol))-ceiling(GCMtime(m_minsol))+1
1414      ! sols that are not fully in the interval are not counted
1415      allocate(int_sol_list(solcount))
1416!      write(*,*) "GCMminsol=", GCMtime(m_minsol)
1417!      write(*,*)"GCMmaxsol=", GCMtime(m_maxsol)
1418      do m=1,solcount
1419        int_sol_list(m)=ceiling(GCMtime(m_minsol)) + m-1
1420      enddo
1421!      write(*,*)"int_sol_list=",int_sol_list
1422
1423
1424      latitude: do j=1,OBSlatlen ! loop on all observed latitudes
1425        lat_val=OBSlat(j)
1426        if ((lat_val.lt.-90.).or.(lat_val.gt.90.)) then
1427          write(*,*) "Unexpected value for OBSlat: ",lat_val
1428          stop
1429        endif
1430
1431        longitude: do i=1,OBSlonlen ! loop on all observed longitudes
1432          lon_val=OBSlon(i)
1433          if ((lon_val.lt.-360.).or.(lon_val.gt.360.)) then
1434            write(*,*) "Unexpected value for lon_val: ",lon_val
1435            stop
1436          endif
1437          ! We want lon_val in [-180:180] for the subroutine extraction
1438          if (lon_val.lt.-180.) lon_val=lon_val+360.
1439          if (lon_val.gt.180.) lon_val=lon_val-360.
1440
1441          LT_val=OBSLT(i,j,l) ! find the Observer average LT value at bin(lon_val, lat_val, Ls_val)
1442
1443          if ((LT_val.lt.0.).or.(LT_val.gt.24.)) then
1444            if (LT_val.eq.LTmiss_val) then
1445!              write(*,*) "Missing value in obsfile for LT_val"
1446              ! Write a missing_value to output
1447              outvar(i,j,:,l) = OBSmiss_val
1448              CYCLE longitude ! go directly to the next longitude
1449            else
1450              write(*,*) "Unexpected value for LT_val: ",LT_val
1451              stop
1452            endif
1453          endif
1454
1455          altitude: do k=1,OBSaltlen ! loop on all observed altitudes
1456            alt_val=OBSalt(k)
1457            if (OBS_var(i,j,k,l).eq.OBSmiss_val) then
1458!              write(*,*) "Missing value in obsfile for ",OBSvarname
1459              ! Write a missing_value to output
1460              outvar(i,j,k,l) = OBSmiss_val
1461              CYCLE altitude ! go directly to the next altitude
1462            endif
1463
1464!===============================================================================
1465! 3.2 Compute GCM sol date corresponding to Observer Ls (via m_(min/max)sol)
1466!       and LT (via OBSLT(min/max))
1467!===============================================================================
1468            LTcount=floor(numbin(i,j,k,l)) ! find the Observer number of temp values
1469                                           ! at bin(lon_val,lat_val,alt_val,Ls_val)
1470            if (LTcount.eq.0.) then
1471              ! Write a missing_value to output
1472              outvar(i,j,k,l) = OBSmiss_val
1473              CYCLE altitude ! go directly to the next altitude
1474            endif
1475            if (LTcount.lt.0.) then
1476              write(*,*) "Unexpected value for LTcount: ",LTcount
1477              stop
1478            endif
1479
1480            ! Generate the sol list for the interpolation
1481            allocate(sol_list(solcount*LTcount))
1482            call gen_sol_list(solcount,int_sol_list,LTcount,LT_val,OBSLTmax(i,j,l),&
1483                              OBSLTmin(i,j,l),lon_val,LTmod,dayornight,&
1484                              sol_list)
1485
1486            solerrcount=0
1487            solbinned_value=0
1488            sol_bin: do m=1,solcount*LTcount ! loop on all GCM sols of the bin
1489              sol=sol_list(m)
1490!              write(*,*)"sol=",sol
1491!===============================================================================
1492! 3.3 Do the interpolation and binning for the given location
1493!===============================================================================
1494              call extraction(lon_val,lat_val,alt_val,sol,&
1495                              GCMlonlen,GCMlatlen,GCMaltlen,GCMtimelen,&
1496                              GCMlon,GCMlat,GCMalt,GCMtime,&
1497                              GCM_var,GCMmiss_val,GCMalttype,GCMvarname,extr_value)
1498
1499              if (extr_value.eq.GCMmiss_val) then
1500!                write(*,*) "Missing value in gcmfile at lon=",lon_val,"; lat=",lat_val,"; alt=",alt_val,"; sol=",sol
1501                solerrcount=solerrcount+1 
1502                CYCLE sol_bin ! go directly to the next GCM sol of the bin
1503              endif
1504              solbinned_value=solbinned_value+extr_value
1505
1506            enddo sol_bin ! end loop on all GCM sols of the bin
1507            if ((solcount*LTcount-solerrcount).ne.0) then
1508              solbinned_value=solbinned_value/(solcount*LTcount-solerrcount)
1509            else
1510!              write(*,*)"No GCM value in this sol bin"
1511              solbinned_value=OBSmiss_val
1512            endif
1513            ! Write value to output
1514            outvar(i,j,k,l)=solbinned_value
1515
1516            errcount=errcount+solerrcount
1517
1518            deallocate(sol_list)
1519
1520          enddo altitude ! end loop on observed altitudes
1521        enddo longitude ! end loop on observed longitudes
1522      enddo latitude ! end loop on observed latitudes
1523
1524      deallocate(int_sol_list)
1525
1526    enddo Ls ! end loop on observed Solar longitudes
1527
1528!    write(*,*)"Nb of GCM missing values :",errcount
1529
1530!=============================================================================== 
1531! 3.4 Write the data in the netcdf output file
1532!===============================================================================
1533    status = nf90_put_var(outfid, outvarid, outvar)
1534    error_text="Error: could not write "//trim(outvarname)//" data in the outfile"
1535    call status_check(status,error_text)
1536 
1537    ! Deallocations before going to the next GCM variable
1538    deallocate(GCM_var)
1539    deallocate(OBS_var)
1540    deallocate(numbin)
1541    deallocate(outvar)
1542  ENDDO VAR ! end loop on variables
1543
1544
1545!===================================================================================
1546! 4. CDOD RATIO (tau_GCM/tau_MCS)
1547!===================================================================================
1548!=============================================================================== 
1549! 4.1 Preliminary checks
1550!===============================================================================
1551  if (OBSalttype.eq.'p') then
1552    tau_ratio_ok = .true.
1553  else
1554    tau_ratio_ok = .false.
1555  endif
1556 
1557  IF (dayornight.EQ."dayside") THEN
1558    out_dztauname = "d"
1559    OBS_dztauname = "ddust"
1560    OBS_tempname = "dtemp"
1561  ELSE ! i.e. dayornight="nightside"
1562    out_dztauname = "n"
1563    OBS_dztauname = "ndust"
1564    OBS_tempname = "ntemp"
1565  ENDIF
1566 
1567  ! Check that the output file contains dust opacity
1568  ! NB: a dust opacity in outfile requires the dust
1569  ! opacity variable to be present in the obsfile,
1570  ! so we don't have to check it out
1571  if (tau_ratio_ok) then
1572    out_dztauname = out_dztauname(1:1)//"dust"
1573    status=nf90_inq_varid(outfid,trim(out_dztauname),out_dztauid)
1574    if (status.ne.nf90_noerr) then
1575      ! if no "d/ndust" in outfile, look for "d/nopa_dust"
1576      out_dztauname = out_dztauname(1:1)//"opa_dust"
1577      status=nf90_inq_varid(outfid,trim(out_dztauname),out_dztauid)
1578      if (status.ne.nf90_noerr) then
1579        ! if no "d/ndust" nor d/nopa_dust" in outfile, look for "d/nopadust" (old variable name from aeroptical, before r2817)
1580        out_dztauname = out_dztauname(1:1)//"opadust"
1581        status=nf90_inq_varid(outfid,trim(out_dztauname),out_dztauid)
1582        if (status.ne.nf90_noerr) then
1583          tau_ratio_ok = .false.
1584          write(*,*)"No dust opacity in the outfile, we skip the computation of the CDOD ratio"
1585        endif
1586      endif
1587    endif
1588  endif
1589 
1590  ! Check that the obsfile contains temperature (for rho computation)
1591  if (tau_ratio_ok) then
1592    status=nf90_inq_varid(obsfid,trim(OBS_tempname),OBS_tempid)
1593    if (status.ne.nf90_noerr) then
1594      tau_ratio_ok = .false.
1595      write(*,*)"No temperature in the obsfile, we skip the computation of the CDOD ratio"
1596    endif
1597  endif
1598
1599
1600!=============================================================================== 
1601! 4.2 tau_ratio computation
1602!===============================================================================
1603  if (tau_ratio_ok) then
1604    write(*,*)"Computing the Column Dust Optical Depths ratio (tau_ratio = tau_GCM/tau_MCS)..."
1605    write(*,*)"(it is recommended to use it to normalize the GCM dust profiles when comparing with MCS dust profiles)"
1606   
1607    ! Creation of the OBS_plev table
1608    IF (dayornight.EQ."dayside") THEN ! only do it once
1609      allocate(OBS_plev(OBSaltlen+1))
1610      DO k=2,OBSaltlen
1611        ! mid-altitude pressure between 2 OBS pressure layers (OBSalt)
1612        ! NB: OBS_plev(k) > OBSalt(k) > OBS_plev(k+1)
1613        OBS_plev(k) = sqrt(OBSalt(k-1)*OBSalt(k))
1614      ENDDO
1615      OBS_plev(1)=2000.
1616      OBS_plev(OBSaltlen+1)=0
1617      write(*,*)"OBS_plev = ",OBS_plev
1618    ENDIF
1619   
1620    ! Arrays allocation
1621    allocate(out_dztau(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
1622    allocate(OBS_dztau(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
1623    allocate(OBS_temp(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
1624   
1625    allocate(tau_ratio(OBSlonlen,OBSlatlen,OBSLslen))
1626    tau_ratio(:,:,:) = 0
1627   
1628    ! Load GCM opacity
1629    status=NF90_GET_VAR(outfid,out_dztauid,out_dztau)
1630    error_text="Failed to load outfile dust opacity"
1631    call status_check(status,error_text)
1632   
1633    ! Load OBS opacity
1634    status=nf90_inq_varid(obsfid,trim(OBS_dztauname),OBS_dztauid)
1635    status=NF90_GET_VAR(OBSfid,OBS_dztauid,OBS_dztau)
1636    error_text="Failed to load obsfile dust opacity"
1637    call status_check(status,error_text)
1638   
1639    ! Load OBS temperature
1640    status=NF90_GET_VAR(OBSfid,OBS_tempid,OBS_temp)
1641    error_text="Failed to load obsfile temperature"
1642    call status_check(status,error_text)
1643   
1644    do l=1,OBSLslen
1645     do j=1,OBSlatlen
1646      do i=1,OBSlonlen
1647        ! initialize both columns to 0
1648        out_tau = 0
1649        OBS_tau = 0
1650        do k=1,OBSlatlen
1651          ! Compute optical depths where both GCM and OBS have non-missing values
1652          ! (especially above the highest (in altitude) of the lowest (in altitude) valid values in the GCM and Observer profile)
1653          IF ((out_dztau(i,j,k,l).ne.OBSmiss_val).and.(OBS_dztau(i,j,k,l).ne.OBSmiss_val).and.(OBS_temp(i,j,k,l).ne.OBSmiss_val)) then
1654            OBS_rho = OBSalt(k) / (r_atm*OBS_temp(i,j,k,l))
1655           
1656            OBS_tau = OBS_tau + OBS_dztau(i,j,k,l)*1.e-3 / OBS_rho /g *(OBS_plev(k)-OBS_plev(k+1))
1657           
1658            out_tau = out_tau + out_dztau(i,j,k,l)*1.e-3 / OBS_rho /g *(OBS_plev(k)-OBS_plev(k+1))
1659           
1660          ENDIF
1661        enddo !alt
1662       
1663        ! Compute the Column Dust Optical Depth ratio
1664        if ((out_tau.eq.0).or.(OBS_tau.eq.0)) then
1665          tau_ratio(i,j,l) = LTmiss_val
1666        else
1667          tau_ratio(i,j,l) = out_tau/OBS_tau
1668        endif
1669       
1670      enddo !lon
1671     enddo !lat
1672    enddo !Ls
1673
1674
1675!=============================================================================== 
1676! 4.3 Write tau_ratio in the netcdf output file
1677!===============================================================================
1678    ! Switch to netcdf define mode
1679    status=nf90_redef(outfid)
1680    error_text="Error: could not switch to define mode in the outfile"
1681    call status_check(status,error_text)
1682
1683    ! Definition of the variable
1684    SELECT CASE (dayornight)
1685    CASE ("dayside")
1686      outvarname = "dtau_ratio"
1687    CASE ("nightside")
1688      outvarname = "ntau_ratio"
1689    END SELECT
1690    status=NF90_DEF_VAR(outfid,trim(outvarname),nf90_float,LTshape,outvarid)
1691    error_text="Error: could not define the variable "//trim(outvarname)//" in the outfile"
1692    call status_check(status,error_text)
1693
1694    ! Write the attributes
1695    long_name = "Integrated optical depths ratio tau_GCM/tau_MCS"
1696    SELECT CASE (dayornight)
1697    CASE ("dayside")
1698      long_name = trim(long_name)//" - day side"
1699      status=nf90_put_att(outfid,outvarid,"long_name",long_name)
1700    CASE ("nightside")
1701      long_name = trim(long_name)//" - night side"
1702      status=nf90_put_att(outfid,outvarid,"long_name",long_name)
1703    END SELECT
1704    status=nf90_put_att(outfid,outvarid,"units","/")
1705    status=nf90_put_att(outfid,outvarid,"_FillValue",LTmiss_val)
1706    comment = "Reference numbin: dust+temp"
1707    status=nf90_put_att(outfid,outvarid,"comment",comment)
1708
1709    write(*,*)trim(outvarname)," has been created in the outfile"
1710    write(*,'("  with missing_value attribute : ",1pe12.5)')LTmiss_val
1711    write(*,*)""
1712
1713    ! End the netcdf define mode (and thus enter the "data writing" mode)
1714    status=nf90_enddef(outfid)
1715    error_text="Error: could not close the define mode of the outfile"
1716    call status_check(status,error_text)
1717
1718    ! Write data
1719    status = nf90_put_var(outfid, outvarid, tau_ratio)
1720    error_text="Error: could not write "//trim(outvarname)//" data in the outfile"
1721    call status_check(status,error_text)
1722
1723    ! Deallocations
1724    deallocate(out_dztau)
1725    deallocate(OBS_dztau)
1726    deallocate(OBS_temp)
1727    deallocate(tau_ratio)
1728
1729  endif !tau_ratio_ok
1730 
1731 
1732!=================================================================================== 
1733! 5. END OF THE DAY/NIGHT LOOP
1734!===================================================================================
1735  IF (dayornight.EQ."dayside") THEN
1736    ! this is the end of the first loop (on daytime values)
1737    ! and we still have to loop on nighttime values
1738    dayornight="nightside"
1739    deallocate(OBSLT)
1740    deallocate(OBSLTmax)
1741    deallocate(OBSLTmin)
1742    write(*,*)""
1743    write(*,*) "Beginning the 2nd loop, on nighttime values"; write(*,*)""
1744    CYCLE DAY_OR_NIGHT
1745  ELSE ! i.e. dayornight="nightside"
1746    ! this is the end of the second loop (on nighttime values)
1747    ! and thus the end of the program
1748    EXIT DAY_OR_NIGHT
1749  ENDIF
1750ENDDO DAY_OR_NIGHT ! end of the day/night loop that begins in section 1.3
1751
1752!===================================================================================
1753! 6. CLOSE THE FILES
1754!===================================================================================
1755status = nf90_close(gcmfid)
1756error_text="Error: could not close file "//trim(gcmfile)
1757call status_check(status,error_text)
1758status = nf90_close(obsfid)
1759error_text="Error: could not close file "//trim(obsfile)
1760call status_check(status,error_text)
1761status = nf90_close(outfid)
1762error_text="Error: could not close file "//trim(outfile)
1763call status_check(status,error_text)
1764
1765write(*,*)"";write(*,*)"-> Program simu_MCS completed!"
1766
1767end program simu_MCS
1768
1769
1770
1771!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1772!===================================================================================================
1773! Subroutines
1774!===================================================================================================
1775
1776subroutine extraction(lon,lat,alt,sol,&
1777                  lonlen,latlen,altlen,timelen,&
1778                  longitude,latitude,altitude,time,&
1779                  field,missing_value,alttype,varname,value)
1780
1781implicit none
1782!================================================================
1783! Arguments:
1784!================================================================
1785real,intent(in) :: lon  ! sought longitude (deg, in [-180:180])
1786real,intent(in) :: lat  ! sought latitude (deg, in [-90:90])
1787real,intent(in) :: alt  ! sought altitude (m or Pa)
1788real,intent(in) :: sol  ! sought date (sols)
1789integer,intent(in) :: lonlen
1790integer,intent(in) :: latlen
1791integer,intent(in) :: altlen
1792integer,intent(in) :: timelen
1793real,intent(in) :: longitude(lonlen)
1794real,intent(in) :: latitude(latlen)
1795real,intent(in) :: altitude(altlen)
1796real,intent(in) :: time(timelen)
1797real,intent(in) :: field(lonlen,latlen,altlen,timelen)
1798real,intent(in) :: missing_value ! default value for "no data"
1799character,intent(in) :: alttype ! altitude coord. type:'z' (altitude, m)
1800                                !                      'p' (pressure, Pa)
1801character(len=*),intent(in) :: varname ! variable name (in GCM file)
1802real,intent(out) :: value
1803
1804!================================================================
1805! Local variables:
1806!================================================================
1807real,save :: prev_lon=-99 ! previous value of 'lon' routine was called with
1808real,save :: prev_lat=-99 ! previous value of 'lat' routine was called with
1809real,save :: prev_alt=-9.e20 ! ! previous value of 'alt'
1810real,save :: prev_sol=-99 ! previous value of 'sol' routine was called with
1811
1812! encompasing indexes:
1813integer,save :: ilon_inf=-1,ilon_sup=-1 ! along longitude
1814integer,save :: ilat_inf=-1,ilat_sup=-1 ! along latitude
1815integer,save :: ialt_inf=-1,ialt_sup=-1 ! along altitude
1816integer,save :: itim_inf=-1,itim_sup=-1 ! along time
1817
1818! intermediate interpolated values
1819real :: t_interp(2,2,2) ! after time interpolation
1820real :: zt_interp(2,2) ! after altitude interpolation
1821real :: yzt_interp(2) ! after latitude interpolation
1822real :: coeff ! interpolation coefficient
1823
1824integer :: i
1825
1826! By default, set value to missing_value
1827value=missing_value
1828
1829!================================================================
1830! 1. Find encompassing indexes
1831!================================================================
1832if (lon.ne.prev_lon) then
1833  do i=1,lonlen-1
1834    if (longitude(i).le.lon) then
1835      ilon_inf=i
1836    else
1837      exit
1838    endif
1839  enddo
1840  ilon_sup=ilon_inf+1
1841endif ! of if (lon.ne.prev_lon)
1842!write(*,*) 'ilon_inf=',ilon_inf," longitude(ilon_inf)=",longitude(ilon_inf)
1843
1844if (lat.ne.prev_lat) then
1845  if (latitude(1).gt.latitude(2)) then
1846  ! decreasing latitudes, from 90N to (-)90S (LMDZ-like)
1847    do i=1,latlen-1
1848      if (latitude(i).ge.lat) then
1849        ilat_inf=i
1850      else
1851        exit
1852      endif
1853    enddo
1854  else
1855  ! increasing latitudes, from (-)90S to 90N (DYNAMICO-like)
1856    do i=1,latlen-1
1857      if (latitude(i).le.lat) then
1858        ilat_inf=i
1859      else
1860        exit
1861      endif
1862    enddo
1863  endif
1864  ilat_sup=ilat_inf+1
1865endif ! of if (lat.ne.prev_lat)
1866!write(*,*) 'ilat_inf=',ilat_inf," latitude(ilat_inf)=",latitude(ilat_inf)
1867
1868if (alt.ne.prev_alt) then
1869  if (alttype.eq.'p') then ! pressures are ordered from max to min
1870    !handle special case for alt not in the altitude(1:altlen) interval
1871    if ((alt.gt.altitude(1)).or.(alt.lt.altitude(altlen))) then
1872      ialt_inf=-1
1873      ialt_sup=-1
1874      ! return to main program (with value=missing_value)
1875!      write(*,*)"Problem in extraction : GCM alt p"
1876      return
1877    else ! general case
1878      do i=1,altlen-1
1879        if (altitude(i).ge.alt) then
1880          ialt_inf=i
1881        else
1882          exit
1883        endif
1884      enddo
1885      ialt_sup=ialt_inf+1
1886    endif ! of if ((alt.gt.altitude(1)).or.(alt.lt.altitude(altlen)))
1887  else ! altitudes (m) are ordered from min to max
1888    !handle special case for alt not in the altitude(1:altlen) interval
1889    if ((alt.lt.altitude(1)).or.(alt.gt.altitude(altlen))) then
1890      ialt_inf=-1
1891      ialt_sup=-1
1892      ! return to main program (with value=missing_value)
1893!      write(*,*)"Problem in extraction : GCM alt z"
1894      return
1895    else ! general case
1896      do i=1,altlen-1
1897        if (altitude(i).le.alt) then
1898          ialt_inf=i
1899        else
1900          exit
1901        endif
1902      enddo
1903      ialt_sup=ialt_inf+1
1904    endif ! of if ((alt.lt.altitude(1)).or.(alt.gt.altitude(altlen)))
1905  endif ! of if (alttype.eq.'p')
1906endif ! of if (alt.ne.prev_alt)
1907!write(*,*) 'ialt_inf=',ialt_inf," altitude(ialt_inf)=",altitude(ialt_inf)
1908
1909if (sol.ne.prev_sol) then
1910  !handle special case for sol not in the time(1):time(timenlen) interval
1911  if ((sol.lt.time(1)).or.(sol.gt.time(timelen))) then
1912    itim_inf=-1
1913    itim_sup=-1
1914    ! return to main program (with value=missing_value)
1915!    write(*,*)"Problem in extraction : GCM sol"
1916    return
1917  else ! general case
1918    do i=1,timelen-1
1919      if (time(i).le.sol) then
1920        itim_inf=i
1921      else
1922        exit
1923      endif
1924    enddo
1925    itim_sup=itim_inf+1
1926  endif ! of if ((sol.lt.time(1)).or.(sol.gt.time(timenlen)))
1927endif ! of if (sol.ne.prev_sol)
1928!write(*,*) 'itim_inf=',itim_inf," time(itim_inf)=",time(itim_inf)
1929!write(*,*) 'itim_sup=',itim_sup," time(itim_sup)=",time(itim_sup)
1930
1931!================================================================
1932! 2. Interpolate
1933!================================================================
1934! check that there are no "missing_value" in the field() elements we need
1935! otherwise return to main program (with value=missing_value)
1936if (field(ilon_inf,ilat_inf,ialt_inf,itim_inf).eq.missing_value) then
1937!  write(*,*)"Error 1 in extraction"
1938  return
1939 endif
1940if (field(ilon_inf,ilat_inf,ialt_inf,itim_sup).eq.missing_value) then
1941!  write(*,*)"Error 2 in extraction"
1942  return
1943 endif
1944if (field(ilon_inf,ilat_inf,ialt_sup,itim_inf).eq.missing_value) then
1945!  write(*,*)"Error 3 in extraction"
1946  return
1947 endif
1948if (field(ilon_inf,ilat_inf,ialt_sup,itim_sup).eq.missing_value) then
1949!  write(*,*)"Error 4 in extraction"
1950  return
1951 endif
1952if (field(ilon_inf,ilat_sup,ialt_inf,itim_inf).eq.missing_value) then
1953!  write(*,*)"Error 5 in extraction"
1954  return
1955 endif
1956if (field(ilon_inf,ilat_sup,ialt_inf,itim_sup).eq.missing_value) then
1957!  write(*,*)"Error 6 in extraction"
1958  return
1959 endif
1960if (field(ilon_inf,ilat_sup,ialt_sup,itim_inf).eq.missing_value) then
1961!  write(*,*)"Error 7 in extraction"
1962  return
1963 endif
1964if (field(ilon_inf,ilat_sup,ialt_sup,itim_sup).eq.missing_value) then
1965!  write(*,*)"Error 8 in extraction"
1966  return
1967 endif
1968if (field(ilon_sup,ilat_inf,ialt_inf,itim_inf).eq.missing_value) then
1969!  write(*,*)"Error 9 in extraction"
1970  return
1971 endif
1972if (field(ilon_sup,ilat_inf,ialt_inf,itim_sup).eq.missing_value) then
1973!  write(*,*)"Error 10 in extraction"
1974  return
1975 endif
1976if (field(ilon_sup,ilat_inf,ialt_sup,itim_inf).eq.missing_value) then
1977!  write(*,*)"Error 11 in extraction"
1978  return
1979 endif
1980if (field(ilon_sup,ilat_inf,ialt_sup,itim_sup).eq.missing_value) then
1981!  write(*,*)"Error 12 in extraction"
1982  return
1983 endif
1984if (field(ilon_sup,ilat_sup,ialt_inf,itim_inf).eq.missing_value) then
1985!  write(*,*)"Error 13 in extraction"
1986  return
1987 endif
1988if (field(ilon_sup,ilat_sup,ialt_inf,itim_sup).eq.missing_value) then
1989!  write(*,*)"Error 14 in extraction"
1990  return
1991 endif
1992if (field(ilon_sup,ilat_sup,ialt_sup,itim_inf).eq.missing_value) then
1993!  write(*,*)"Error 15 in extraction"
1994  return
1995 endif
1996if (field(ilon_sup,ilat_sup,ialt_sup,itim_sup).eq.missing_value) then
1997!  write(*,*)"Error 16 in extraction"
1998  return
1999 endif
2000
2001!================================================================
2002! 2.1 Linear interpolation in time
2003!================================================================
2004coeff=(sol-time(itim_inf))/(time(itim_sup)-time(itim_inf))
2005t_interp(1,1,1)=field(ilon_inf,ilat_inf,ialt_inf,itim_inf)+ &
2006                coeff*(field(ilon_inf,ilat_inf,ialt_inf,itim_sup)- &
2007                       field(ilon_inf,ilat_inf,ialt_inf,itim_inf))
2008t_interp(1,1,2)=field(ilon_inf,ilat_inf,ialt_sup,itim_inf)+ &
2009                coeff*(field(ilon_inf,ilat_inf,ialt_sup,itim_sup)- &
2010                       field(ilon_inf,ilat_inf,ialt_sup,itim_inf))
2011t_interp(1,2,1)=field(ilon_inf,ilat_sup,ialt_inf,itim_inf)+ &
2012                coeff*(field(ilon_inf,ilat_sup,ialt_inf,itim_sup)- &
2013                       field(ilon_inf,ilat_sup,ialt_inf,itim_inf))
2014t_interp(1,2,2)=field(ilon_inf,ilat_sup,ialt_sup,itim_inf)+ &
2015                coeff*(field(ilon_inf,ilat_sup,ialt_sup,itim_sup)- &
2016                       field(ilon_inf,ilat_sup,ialt_sup,itim_inf))
2017t_interp(2,1,1)=field(ilon_sup,ilat_inf,ialt_inf,itim_inf)+ &
2018                coeff*(field(ilon_sup,ilat_inf,ialt_inf,itim_sup)- &
2019                       field(ilon_sup,ilat_inf,ialt_inf,itim_inf))
2020t_interp(2,1,2)=field(ilon_sup,ilat_inf,ialt_sup,itim_inf)+ &
2021                coeff*(field(ilon_sup,ilat_inf,ialt_sup,itim_sup)- &
2022                       field(ilon_sup,ilat_inf,ialt_sup,itim_inf))
2023t_interp(2,2,1)=field(ilon_sup,ilat_sup,ialt_inf,itim_inf)+ &
2024                coeff*(field(ilon_sup,ilat_sup,ialt_inf,itim_sup)- &
2025                       field(ilon_sup,ilat_sup,ialt_inf,itim_inf))
2026t_interp(2,2,2)=field(ilon_sup,ilat_sup,ialt_sup,itim_inf)+ &
2027                coeff*(field(ilon_sup,ilat_sup,ialt_sup,itim_sup)- &
2028                       field(ilon_sup,ilat_sup,ialt_sup,itim_inf))
2029
2030!================================================================
2031! 2.2 Vertical interpolation
2032!================================================================
2033if (((varname=='rho').or.(varname=='pressure')).and.(alttype=='z')) then
2034  ! do the interpolation on the log of the quantity
2035  coeff=(alt-altitude(ialt_inf))/(altitude(ialt_sup)-altitude(ialt_inf))
2036  zt_interp(1,1)=log(t_interp(1,1,1))+coeff* &
2037                             (log(t_interp(1,1,2))-log(t_interp(1,1,1)))
2038  zt_interp(1,2)=log(t_interp(1,2,1))+coeff* &
2039                             (log(t_interp(1,2,2))-log(t_interp(1,2,1)))
2040  zt_interp(2,1)=log(t_interp(2,1,1))+coeff* &
2041                             (log(t_interp(2,1,2))-log(t_interp(2,1,1)))
2042  zt_interp(2,2)=log(t_interp(2,2,1))+coeff* &
2043                             (log(t_interp(2,2,2))-log(t_interp(2,2,1)))
2044  zt_interp(1:2,1:2)=exp(zt_interp(1:2,1:2))
2045else ! general case
2046  coeff=(alt-altitude(ialt_inf))/(altitude(ialt_sup)-altitude(ialt_inf))
2047  zt_interp(1,1)=t_interp(1,1,1)+coeff*(t_interp(1,1,2)-t_interp(1,1,1))
2048  zt_interp(1,2)=t_interp(1,2,1)+coeff*(t_interp(1,2,2)-t_interp(1,2,1))
2049  zt_interp(2,1)=t_interp(2,1,1)+coeff*(t_interp(2,1,2)-t_interp(2,1,1))
2050  zt_interp(2,2)=t_interp(2,2,1)+coeff*(t_interp(2,2,2)-t_interp(2,2,1))
2051endif
2052
2053!================================================================
2054! 2.3 Latitudinal interpolation
2055!================================================================
2056coeff=(lat-latitude(ilat_inf))/(latitude(ilat_sup)-latitude(ilat_inf))
2057yzt_interp(1)=zt_interp(1,1)+coeff*(zt_interp(1,2)-zt_interp(1,1))
2058yzt_interp(2)=zt_interp(2,1)+coeff*(zt_interp(2,2)-zt_interp(2,1))
2059
2060!================================================================
2061! 2.4 longitudinal interpolation
2062!================================================================
2063coeff=(lon-longitude(ilon_inf))/(longitude(ilon_sup)-longitude(ilon_inf))
2064value=yzt_interp(1)+coeff*(yzt_interp(2)-yzt_interp(1))
2065
2066end subroutine extraction
2067
2068!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2069
2070subroutine inidim(outfid,lonlen,latlen,altlen,timelen,lon,lat,alt,time,units_alt,&
2071                     londimid,latdimid,altdimid,timedimid)
2072!================================================================
2073! Purpose:
2074! Initialize a data file (NetCDF format)
2075!================================================================
2076! Remarks:
2077! The NetCDF file remains open
2078!================================================================
2079use netcdf ! NetCDF definitions
2080implicit none
2081!================================================================
2082! Arguments:
2083!================================================================
2084integer, intent(in):: outfid
2085! outfid: [netcdf] file ID
2086integer, intent(in):: lonlen
2087! lonlen: longitude length (# of longitude values)
2088integer, intent(in):: latlen
2089! latlen: latitude length (# of latitude values)
2090integer, intent(in):: altlen
2091! altlen: altitude length (# of altitude values)
2092integer, intent(in):: timelen
2093! timelen: time length (# of time values)
2094real, intent(in):: lon(lonlen)
2095! lon(): longitude
2096real, intent(in):: lat(latlen)
2097! lat(): latitude
2098real, intent(in):: alt(altlen)
2099! alt(): altitude
2100real, intent(in):: time(timelen)
2101! time(): time (Ls)
2102character(len=1), intent(in) :: units_alt
2103! units_alt: altitude coord. type:'z' (altitude, m) 'p' (pressure, Pa)
2104integer,intent(inout):: londimid
2105! londimid: [netcdf] lon() (i.e.: longitude) ID in MCS and output files (they are the same)
2106integer,intent(inout) :: latdimid
2107! latdimid: [netcdf] lat() ID in MCS and output files (they are the same)
2108integer,intent(inout):: altdimid
2109! altdimid: [netcdf] alt() ID in MCS and output files (they are the same)
2110integer,intent(inout):: timedimid
2111! timedimid: [netcdf] time() ID in MCS and output files (they are the same)
2112
2113!================================================================
2114! Local variables:
2115!================================================================
2116integer :: lonvarid,latvarid,altvarid,timevarid,status
2117! *varid: [netcdf] ID of a variable
2118! status: [netcdf]  return error code (from called subroutines)
2119character(len=256) :: error_text
2120integer :: d ! loop index on dimensions ID
2121
2122!===============================================================
2123! 1. Define/write "dimensions" in the same order than MCS file
2124!    and get their IDs
2125!================================================================
2126do d=1,4
2127  if (altdimid.eq.d) then
2128    status=nf90_def_dim(outfid, "altitude", altlen, altdimid)
2129    error_text="Error: could not define the altitude dimension in the outfile"
2130    call status_check(status,error_text)
2131  else if (timedimid.eq.d) then
2132    status=nf90_def_dim(outfid, "time", timelen, timedimid)
2133    error_text="Error: could not define the time dimension in the outfile"
2134    call status_check(status,error_text)
2135  else if (latdimid.eq.d) then
2136    status=nf90_def_dim(outfid, "latitude", latlen, latdimid)
2137    error_text="Error: could not define the latitude dimension in the outfile"
2138    call status_check(status,error_text)
2139  else if (londimid.eq.d) then
2140    status=nf90_def_dim(outfid, "longitude", lonlen, londimid)
2141    error_text="Error: could not define the longitude dimension in the outfile"
2142    call status_check(status,error_text)
2143  endif
2144enddo
2145
2146!================================================================
2147! 2. Define "variables" and their attributes
2148!================================================================
2149!================================================================
2150! 2.1 Write "longitude" (data and attributes)
2151!================================================================
2152
2153! Insert the definition of the variable
2154status=nf90_def_var(outfid,"longitude",nf90_float,(/londimid/),lonvarid)
2155error_text="Error: could not define the longitude variable in the outfile"
2156call status_check(status,error_text)
2157
2158! Write the attributes
2159status=nf90_put_att(outfid,lonvarid,"long_name","longitude")
2160error_text="Error: could not put the long_name attribute for the longitude variable in the outfile"
2161call status_check(status,error_text)
2162
2163status=nf90_put_att(outfid,lonvarid,"units","degrees_east")
2164error_text="Error: could not put the units attribute for the longitude variable in the outfile"
2165call status_check(status,error_text)
2166
2167!================================================================
2168! 2.2 "latitude"
2169!================================================================
2170
2171! Insert the definition of the variable
2172status=nf90_def_var(outfid,"latitude",nf90_float,(/latdimid/),latvarid)
2173error_text="Error: could not define the latitude variable in the outfile"
2174call status_check(status,error_text)
2175
2176! Write the attributes
2177status=nf90_put_att(outfid,latvarid,"long_name","latitude")
2178error_text="Error: could not put the long_name attribute for the latitude variable in the outfile"
2179call status_check(status,error_text)
2180
2181status=nf90_put_att(outfid,latvarid,"units","degrees_north")
2182error_text="Error: could not put the units attribute for the latitude variable in the outfile"
2183call status_check(status,error_text)
2184
2185!================================================================
2186! 2.3 Write "altitude" (data and attributes)
2187!================================================================
2188
2189! Insert the definition of the variable
2190status=nf90_def_var(outfid,"altitude",nf90_float,(/altdimid/),altvarid)
2191error_text="Error: could not define the altitude variable in the outfile"
2192call status_check(status,error_text)
2193
2194! Write the attributes
2195if (units_alt.eq.'p') then ! pressure coordinate
2196  status=nf90_put_att(outfid,altvarid,"long_name","pressure")
2197  error_text="Error: could not put the long_name attribute for the altitude variable in the outfile"
2198  call status_check(status,error_text)
2199
2200  status=nf90_put_att(outfid,altvarid,'units',"Pa")
2201  error_text="Error: could not put the units attribute for the altitude variable in the outfile"
2202  call status_check(status,error_text)
2203
2204  status=nf90_put_att(outfid,altvarid,'positive',"down")
2205  error_text="Error: could not put the positive attribute for the altitude variable in the outfile"
2206  call status_check(status,error_text)
2207
2208  status=nf90_put_att(outfid,altvarid,'comment',&
2209  "The vertical variable is in fact pressure, not altitude. We just call it altitude for easy reading in Ferret and Grads.")
2210  error_text="Error: could not put the comment attribute for the altitude variable in the outfile"
2211  call status_check(status,error_text)
2212
2213else if (units_alt.eq.'z') then ! altitude coordinate
2214  status=nf90_put_att(outfid,altvarid,"long_name","altitude")
2215  error_text="Error: could not put the long_name attribute for the altitude variable in the outfile"
2216  call status_check(status,error_text)
2217
2218  status=nf90_put_att(outfid,altvarid,'units',"m")
2219  error_text="Error: could not put the units attribute for the altitude variable in the outfile"
2220  call status_check(status,error_text)
2221
2222  status=nf90_put_att(outfid,altvarid,'positive',"up")
2223  error_text="Error: could not put the positive attribute for the altitude variable in the outfile"
2224  call status_check(status,error_text)
2225
2226else
2227  write(*,*)"I do not understand this unit type ",units_alt," for outfile altitude!"
2228  stop
2229end if
2230
2231!================================================================
2232! 2.4 "time"
2233!================================================================
2234
2235! Insert the definition of the variable
2236status=nf90_def_var(outfid,"time",nf90_float,(/timedimid/),timevarid)
2237error_text="Error: could not define the time variable in the outfile"
2238call status_check(status,error_text)
2239
2240! Write the attributes
2241status=nf90_put_att(outfid,timevarid,"long_name","Solar longitude")
2242error_text="Error: could not put the long_name attribute for the time variable in the outfile"
2243call status_check(status,error_text)
2244
2245status=nf90_put_att(outfid,timevarid,"units","days since 0000-01-1 00:00:00")
2246error_text="Error: could not put the units attribute for the time variable in the outfile"
2247call status_check(status,error_text)
2248
2249status=nf90_put_att(outfid,timevarid,"comment",&
2250"Units is in fact degrees, but set to a dummy value of days for compatibility with Ferret and Grads.")
2251error_text="Error: could not put the comment attribute for the time variable in the outfile"
2252call status_check(status,error_text)
2253
2254!================================================================
2255! 2.5 End netcdf define mode
2256!================================================================
2257status=nf90_enddef(outfid)
2258error_text="Error: could not end the define mode of the outfile"
2259call status_check(status,error_text)
2260
2261!================================================================
2262! 3. Write "variables" (data of the dimension variables)
2263!================================================================
2264! "time"
2265status=nf90_put_var(outfid,timevarid,time)
2266error_text="Error: could not write the time variable's data in the outfile"
2267call status_check(status,error_text)
2268
2269! "latitude"
2270status=nf90_put_var(outfid,latvarid,lat)
2271error_text="Error: could not write the latitude variable's data in the outfile"
2272call status_check(status,error_text)
2273
2274! "longitude"
2275status=nf90_put_var(outfid,lonvarid,lon)
2276error_text="Error: could not write the longitude variable's data in the outfile"
2277call status_check(status,error_text)
2278
2279! "altitude"
2280status=nf90_put_var(outfid,altvarid,alt)
2281error_text="Error: could not write the altitude variable's data in the outfile"
2282call status_check(status,error_text)
2283
2284end subroutine inidim
2285
2286!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2287
2288subroutine ls2sol(ls,sol)
2289
2290implicit none
2291!================================================================
2292!  Arguments:
2293!================================================================
2294real,intent(in) :: ls
2295real,intent(out) :: sol
2296
2297!================================================================
2298!  Local:
2299!================================================================
2300double precision xref,zx0,zteta,zz
2301!xref: mean anomaly, zteta: true anomaly, zx0: eccentric anomaly
2302double precision year_day
2303double precision peri_day,timeperi,e_elips
2304double precision pi,degrad
2305parameter (year_day=668.6d0) ! number of sols in a martian year
2306parameter (peri_day=485.35d0) ! date (in sols) of perihelion
2307!timeperi: 2*pi*( 1 - Ls(perihelion)/ 360 ); Ls(perihelion)=250.99
2308parameter (timeperi=1.90258341759902d0)
2309parameter (e_elips=0.0934d0)  ! eccentricity of orbit
2310parameter (pi=3.14159265358979d0)
2311parameter (degrad=57.2957795130823d0)
2312
2313      if (abs(ls).lt.1.0e-5) then
2314         if (ls.ge.0.0) then
2315            sol = 0.0
2316         else
2317            sol = real(year_day)
2318         end if
2319         return
2320      end if
2321
2322      zteta = ls/degrad + timeperi
2323      zx0 = 2.0*datan(dtan(0.5*zteta)/dsqrt((1.+e_elips)/(1.-e_elips)))
2324      xref = zx0-e_elips*dsin(zx0)
2325      zz = xref/(2.*pi)
2326      sol = real(zz*year_day + peri_day)
2327      if (sol.lt.0.0) sol = sol + real(year_day)
2328      if (sol.ge.year_day) sol = sol - real(year_day)
2329
2330
2331end subroutine ls2sol
2332
2333!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2334
2335subroutine gen_sol_list(solcount,int_sol_list,LTcount,LTave,LTmax,LTmin,lon,f_LT,dayornight,&
2336                        sol_list)
2337!================================================================
2338! Purpose:
2339! Generate a list that is the combination of two lists :
2340! - int_sol_list, which is a list of integer values of sol
2341! - LT_list, which contains a number LTcount of LT values in the
2342!   interval [LTmin;LTmax] which are evenly distributed around
2343!   LTave (so that their average is LTave)
2344!================================================================
2345
2346implicit none
2347!================================================================
2348! Arguments:
2349!================================================================
2350integer, intent(in) :: solcount ! nb of integer values of sol
2351real, intent(in) :: int_sol_list(solcount) ! list of the integer values of sol
2352integer, intent(in) :: LTcount ! nb of LT per sol to be interpolated
2353real, intent(in) :: LTave ! average of LT
2354real, intent(in) :: LTmax, LTmin ! bounds of the LT interval for the interpolation
2355real, intent(in) :: lon ! longitude value for the transformation into a sol value at lon=0°
2356external f_LT ! function that changes LT interval for night LT
2357real f_LT
2358character (len=10), intent(in) :: dayornight ! to know if we have day or night values
2359
2360real, intent(out) :: sol_list(solcount*LTcount) ! all the sol values at lon=0° to interpolate
2361
2362!================================================================
2363! Local variables:
2364!================================================================
2365integer :: N
2366integer :: a,b,c ! loop iteration indexes
2367real :: LT_list(LTcount)
2368
2369N = floor(LTcount/2.)
2370
2371!================================================================
2372! 1. Filling of LT_list
2373!================================================================
2374SELECT CASE (dayornight)
2375CASE ("dayside")
2376  if (abs(LTave-LTmax).le.abs(LTave-LTmin)) then ! LTave is closer to LTmax than to LTmin
2377  do a=1,N
2378    LT_list(a)=LTave+a*abs(LTave-LTmax)/(N+1)
2379    LT_list(N+a)=LTave-a*abs(LTave-LTmax)/(N+1)
2380  enddo
2381else ! LTave is closer to LTmin than to LTmax
2382  do a=1,N
2383    LT_list(a)=LTave+a*abs(LTave-LTmin)/(N+1)
2384    LT_list(N+a)=LTave-a*abs(LTave-LTmin)/(N+1)
2385  enddo
2386endif
2387CASE ("nightside")
2388  if (abs(f_LT(LTave)-f_LT(LTmax)).le.abs(f_LT(LTave)-f_LT(LTmin))) then ! LTave is closer to LTmax than to LTmin
2389    do a=1,N
2390      LT_list(a)=LTave+a*abs(f_LT(LTave)-f_LT(LTmax))/(N+1)
2391      LT_list(a)=mod(LT_list(a),24.) ! reput the LT in a [0;24[ interval if needed
2392      LT_list(N+a)=LTave-a*abs(f_LT(LTave)-f_LT(LTmax))/(N+1)
2393      LT_list(N+a)=mod(LT_list(N+a),24.)
2394    enddo
2395  else ! LTave is closer to LTmin than to LTmax
2396    do a=1,N
2397      LT_list(a)=LTave+a*abs(f_LT(LTave)-f_LT(LTmin))/(N+1)
2398      LT_list(a)=mod(LT_list(a),24.)
2399      LT_list(N+a)=LTave-a*abs(f_LT(LTave)-f_LT(LTmin))/(N+1)
2400      LT_list(N+a)=mod(LT_list(N+a),24.)
2401    enddo
2402  endif
2403END SELECT
2404
2405if (mod(LTcount,2).eq.1) then ! if LTcount is an odd number
2406  LT_list(LTcount)=LTave ! add LTave to the list
2407endif
2408
2409!================================================================
2410! 2. Combination of int_sol_list & LT_list into sol_list
2411!================================================================
2412c=1
2413do a=1,solcount
2414  do b=1,LTcount
2415    sol_list(c)=int_sol_list(a)+(LT_list(b)-lon/15.)/24.
2416    c=c+1
2417  enddo
2418enddo
2419
2420end subroutine gen_sol_list
2421
2422!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2423
2424subroutine status_check(status,error_text)
2425
2426use netcdf
2427implicit none
2428!================================================================
2429!  Arguments:
2430!================================================================
2431integer,intent(in) :: status
2432character(len=256),intent(in) :: error_text
2433
2434if (status.ne.nf90_noerr) then
2435  write(*,*)trim(error_text)
2436  write(*,*)trim(nf90_strerror(status))
2437  stop
2438endif
2439
2440end subroutine status_check
2441
2442!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2443
2444real function LTmod(LT)
2445!================================================================
2446! Purpose:
2447! For night local times management, replace hours 
2448! from a [0;24[ interval to a [-12;12[ interval in which
2449! midnight = 0 (in order to ensure continuity when comparing
2450! night local times)
2451!================================================================
2452implicit none
2453real,intent(in) :: LT
2454
2455LTmod = 2*mod(LT,12.)-LT
2456return
2457end function LTmod
Note: See TracBrowser for help on using the repository browser.