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

Last change on this file since 2908 was 2558, checked in by abierjon, 3 years ago

Mars GCM:
simu_MCS.F90 : now computes the column-integrated dust optical depths of the MCS and GCM files
(between levels with no missing values in both files, which vary with space and time) and outputs
the ratio tau_GCM/tau_MCS to be used to normalize the GCM dust opacity profiles when comparing to MCSake simu_MCS.F90 compatible with DYNAMICO lon-lat output files, with a check on the latitude array order when doing the interpolation

AB

File size: 97.8 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/nopadust"
1576      out_dztauname = out_dztauname(1:1)//"opadust"
1577      status=nf90_inq_varid(outfid,trim(out_dztauname),out_dztauid)
1578      if (status.ne.nf90_noerr) then
1579        tau_ratio_ok = .false.
1580        write(*,*)"No dust opacity in the outfile, we'll pass the computation of the CDOD ratio"
1581      endif
1582    endif
1583  endif
1584 
1585  ! Check that the obsfile contains temperature (for rho computation)
1586  if (tau_ratio_ok) then
1587    status=nf90_inq_varid(obsfid,trim(OBS_tempname),OBS_tempid)
1588    if (status.ne.nf90_noerr) then
1589      tau_ratio_ok = .false.
1590      write(*,*)"No temperature in the outfile, we'll pass the computation of the CDOD ratio"
1591    endif
1592  endif
1593
1594
1595!=============================================================================== 
1596! 4.2 tau_ratio computation
1597!===============================================================================
1598  if (tau_ratio_ok) then
1599    write(*,*)"Computing the Column Dust Optical Depths ratio (tau_ratio = tau_GCM/tau_MCS)..."
1600    write(*,*)"(it is recommended to use it to normalize the GCM dust profiles when comparing with MCS dust profiles)"
1601   
1602    ! Creation of the OBS_plev table
1603    IF (dayornight.EQ."dayside") THEN ! only do it once
1604      allocate(OBS_plev(OBSaltlen+1))
1605      DO k=2,OBSaltlen
1606        ! mid-altitude pressure between 2 OBS pressure layers (OBSalt)
1607        ! NB: OBS_plev(k) > OBSalt(k) > OBS_plev(k+1)
1608        OBS_plev(k) = sqrt(OBSalt(k-1)*OBSalt(k))
1609      ENDDO
1610      OBS_plev(1)=2000.
1611      OBS_plev(OBSaltlen+1)=0
1612      write(*,*)"OBS_plev = ",OBS_plev
1613    ENDIF
1614   
1615    ! Arrays allocation
1616    allocate(out_dztau(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
1617    allocate(OBS_dztau(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
1618    allocate(OBS_temp(OBSlonlen,OBSlatlen,OBSaltlen,OBSLslen))
1619   
1620    allocate(tau_ratio(OBSlonlen,OBSlatlen,OBSLslen))
1621    tau_ratio(:,:,:) = 0
1622   
1623    ! Load GCM opacity
1624    status=NF90_GET_VAR(outfid,out_dztauid,out_dztau)
1625    error_text="Failed to load outfile dust opacity"
1626    call status_check(status,error_text)
1627   
1628    ! Load OBS opacity
1629    status=nf90_inq_varid(obsfid,trim(OBS_dztauname),OBS_dztauid)
1630    status=NF90_GET_VAR(OBSfid,OBS_dztauid,OBS_dztau)
1631    error_text="Failed to load obsfile dust opacity"
1632    call status_check(status,error_text)
1633   
1634    ! Load OBS temperature
1635    status=NF90_GET_VAR(OBSfid,OBS_tempid,OBS_temp)
1636    error_text="Failed to load obsfile temperature"
1637    call status_check(status,error_text)
1638   
1639    do l=1,OBSLslen
1640     do j=1,OBSlatlen
1641      do i=1,OBSlonlen
1642        ! initialize both columns to 0
1643        out_tau = 0
1644        OBS_tau = 0
1645        do k=1,OBSlatlen
1646          ! Compute optical depths where both GCM and OBS have non-missing values
1647          ! (especially above the highest (in altitude) of the lowest (in altitude) valid values in the GCM and Observer profile)
1648          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
1649            OBS_rho = OBSalt(k) / (r_atm*OBS_temp(i,j,k,l))
1650           
1651            OBS_tau = OBS_tau + OBS_dztau(i,j,k,l)*1.e-3 / OBS_rho /g *(OBS_plev(k)-OBS_plev(k+1))
1652           
1653            out_tau = out_tau + out_dztau(i,j,k,l)*1.e-3 / OBS_rho /g *(OBS_plev(k)-OBS_plev(k+1))
1654           
1655          ENDIF
1656        enddo !alt
1657       
1658        ! Compute the Column Dust Optical Depth ratio
1659        if ((out_tau.eq.0).or.(OBS_tau.eq.0)) then
1660          tau_ratio(i,j,l) = LTmiss_val
1661        else
1662          tau_ratio(i,j,l) = out_tau/OBS_tau
1663        endif
1664       
1665      enddo !lon
1666     enddo !lat
1667    enddo !Ls
1668
1669
1670!=============================================================================== 
1671! 4.3 Write tau_ratio in the netcdf output file
1672!===============================================================================
1673    ! Switch to netcdf define mode
1674    status=nf90_redef(outfid)
1675    error_text="Error: could not switch to define mode in the outfile"
1676    call status_check(status,error_text)
1677
1678    ! Definition of the variable
1679    SELECT CASE (dayornight)
1680    CASE ("dayside")
1681      outvarname = "dtau_ratio"
1682    CASE ("nightside")
1683      outvarname = "ntau_ratio"
1684    END SELECT
1685    status=NF90_DEF_VAR(outfid,trim(outvarname),nf90_float,LTshape,outvarid)
1686    error_text="Error: could not define the variable "//trim(outvarname)//" in the outfile"
1687    call status_check(status,error_text)
1688
1689    ! Write the attributes
1690    long_name = "Integrated optical depths ratio tau_GCM/tau_MCS"
1691    SELECT CASE (dayornight)
1692    CASE ("dayside")
1693      long_name = trim(long_name)//" - day side"
1694      status=nf90_put_att(outfid,outvarid,"long_name",long_name)
1695    CASE ("nightside")
1696      long_name = trim(long_name)//" - night side"
1697      status=nf90_put_att(outfid,outvarid,"long_name",long_name)
1698    END SELECT
1699    status=nf90_put_att(outfid,outvarid,"units","/")
1700    status=nf90_put_att(outfid,outvarid,"_FillValue",LTmiss_val)
1701    comment = "Reference numbin: dust+temp"
1702    status=nf90_put_att(outfid,outvarid,"comment",comment)
1703
1704    write(*,*)trim(outvarname)," has been created in the outfile"
1705    write(*,'("  with missing_value attribute : ",1pe12.5)')LTmiss_val
1706    write(*,*)""
1707
1708    ! End the netcdf define mode (and thus enter the "data writing" mode)
1709    status=nf90_enddef(outfid)
1710    error_text="Error: could not close the define mode of the outfile"
1711    call status_check(status,error_text)
1712
1713    ! Write data
1714    status = nf90_put_var(outfid, outvarid, tau_ratio)
1715    error_text="Error: could not write "//trim(outvarname)//" data in the outfile"
1716    call status_check(status,error_text)
1717
1718    ! Deallocations
1719    deallocate(out_dztau)
1720    deallocate(OBS_dztau)
1721    deallocate(OBS_temp)
1722    deallocate(tau_ratio)
1723
1724  endif !tau_ratio_ok
1725 
1726 
1727!=================================================================================== 
1728! 5. END OF THE DAY/NIGHT LOOP
1729!===================================================================================
1730  IF (dayornight.EQ."dayside") THEN
1731    ! this is the end of the first loop (on daytime values)
1732    ! and we still have to loop on nighttime values
1733    dayornight="nightside"
1734    deallocate(OBSLT)
1735    deallocate(OBSLTmax)
1736    deallocate(OBSLTmin)
1737    write(*,*)""
1738    write(*,*) "Beginning the 2nd loop, on nighttime values"; write(*,*)""
1739    CYCLE DAY_OR_NIGHT
1740  ELSE ! i.e. dayornight="nightside"
1741    ! this is the end of the second loop (on nighttime values)
1742    ! and thus the end of the program
1743    EXIT DAY_OR_NIGHT
1744  ENDIF
1745ENDDO DAY_OR_NIGHT ! end of the day/night loop that begins in section 1.3
1746
1747!===================================================================================
1748! 6. CLOSE THE FILES
1749!===================================================================================
1750status = nf90_close(gcmfid)
1751error_text="Error: could not close file "//trim(gcmfile)
1752call status_check(status,error_text)
1753status = nf90_close(obsfid)
1754error_text="Error: could not close file "//trim(obsfile)
1755call status_check(status,error_text)
1756status = nf90_close(outfid)
1757error_text="Error: could not close file "//trim(outfile)
1758call status_check(status,error_text)
1759
1760write(*,*)"";write(*,*)"-> Program simu_MCS completed!"
1761
1762end program simu_MCS
1763
1764
1765
1766!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1767!===================================================================================================
1768! Subroutines
1769!===================================================================================================
1770
1771subroutine extraction(lon,lat,alt,sol,&
1772                  lonlen,latlen,altlen,timelen,&
1773                  longitude,latitude,altitude,time,&
1774                  field,missing_value,alttype,varname,value)
1775
1776implicit none
1777!================================================================
1778! Arguments:
1779!================================================================
1780real,intent(in) :: lon  ! sought longitude (deg, in [-180:180])
1781real,intent(in) :: lat  ! sought latitude (deg, in [-90:90])
1782real,intent(in) :: alt  ! sought altitude (m or Pa)
1783real,intent(in) :: sol  ! sought date (sols)
1784integer,intent(in) :: lonlen
1785integer,intent(in) :: latlen
1786integer,intent(in) :: altlen
1787integer,intent(in) :: timelen
1788real,intent(in) :: longitude(lonlen)
1789real,intent(in) :: latitude(latlen)
1790real,intent(in) :: altitude(altlen)
1791real,intent(in) :: time(timelen)
1792real,intent(in) :: field(lonlen,latlen,altlen,timelen)
1793real,intent(in) :: missing_value ! default value for "no data"
1794character,intent(in) :: alttype ! altitude coord. type:'z' (altitude, m)
1795                                !                      'p' (pressure, Pa)
1796character(len=*),intent(in) :: varname ! variable name (in GCM file)
1797real,intent(out) :: value
1798
1799!================================================================
1800! Local variables:
1801!================================================================
1802real,save :: prev_lon=-99 ! previous value of 'lon' routine was called with
1803real,save :: prev_lat=-99 ! previous value of 'lat' routine was called with
1804real,save :: prev_alt=-9.e20 ! ! previous value of 'alt'
1805real,save :: prev_sol=-99 ! previous value of 'sol' routine was called with
1806
1807! encompasing indexes:
1808integer,save :: ilon_inf=-1,ilon_sup=-1 ! along longitude
1809integer,save :: ilat_inf=-1,ilat_sup=-1 ! along latitude
1810integer,save :: ialt_inf=-1,ialt_sup=-1 ! along altitude
1811integer,save :: itim_inf=-1,itim_sup=-1 ! along time
1812
1813! intermediate interpolated values
1814real :: t_interp(2,2,2) ! after time interpolation
1815real :: zt_interp(2,2) ! after altitude interpolation
1816real :: yzt_interp(2) ! after latitude interpolation
1817real :: coeff ! interpolation coefficient
1818
1819integer :: i
1820
1821! By default, set value to missing_value
1822value=missing_value
1823
1824!================================================================
1825! 1. Find encompassing indexes
1826!================================================================
1827if (lon.ne.prev_lon) then
1828  do i=1,lonlen-1
1829    if (longitude(i).le.lon) then
1830      ilon_inf=i
1831    else
1832      exit
1833    endif
1834  enddo
1835  ilon_sup=ilon_inf+1
1836endif ! of if (lon.ne.prev_lon)
1837!write(*,*) 'ilon_inf=',ilon_inf," longitude(ilon_inf)=",longitude(ilon_inf)
1838
1839if (lat.ne.prev_lat) then
1840  if (latitude(1).gt.latitude(2)) then
1841  ! decreasing latitudes, from 90N to (-)90S (LMDZ-like)
1842    do i=1,latlen-1
1843      if (latitude(i).ge.lat) then
1844        ilat_inf=i
1845      else
1846        exit
1847      endif
1848    enddo
1849  else
1850  ! increasing latitudes, from (-)90S to 90N (DYNAMICO-like)
1851    do i=1,latlen-1
1852      if (latitude(i).le.lat) then
1853        ilat_inf=i
1854      else
1855        exit
1856      endif
1857    enddo
1858  endif
1859  ilat_sup=ilat_inf+1
1860endif ! of if (lat.ne.prev_lat)
1861!write(*,*) 'ilat_inf=',ilat_inf," latitude(ilat_inf)=",latitude(ilat_inf)
1862
1863if (alt.ne.prev_alt) then
1864  if (alttype.eq.'p') then ! pressures are ordered from max to min
1865    !handle special case for alt not in the altitude(1:altlen) interval
1866    if ((alt.gt.altitude(1)).or.(alt.lt.altitude(altlen))) then
1867      ialt_inf=-1
1868      ialt_sup=-1
1869      ! return to main program (with value=missing_value)
1870!      write(*,*)"Problem in extraction : GCM alt p"
1871      return
1872    else ! general case
1873      do i=1,altlen-1
1874        if (altitude(i).ge.alt) then
1875          ialt_inf=i
1876        else
1877          exit
1878        endif
1879      enddo
1880      ialt_sup=ialt_inf+1
1881    endif ! of if ((alt.gt.altitude(1)).or.(alt.lt.altitude(altlen)))
1882  else ! altitudes (m) are ordered from min to max
1883    !handle special case for alt not in the altitude(1:altlen) interval
1884    if ((alt.lt.altitude(1)).or.(alt.gt.altitude(altlen))) then
1885      ialt_inf=-1
1886      ialt_sup=-1
1887      ! return to main program (with value=missing_value)
1888!      write(*,*)"Problem in extraction : GCM alt z"
1889      return
1890    else ! general case
1891      do i=1,altlen-1
1892        if (altitude(i).le.alt) then
1893          ialt_inf=i
1894        else
1895          exit
1896        endif
1897      enddo
1898      ialt_sup=ialt_inf+1
1899    endif ! of if ((alt.lt.altitude(1)).or.(alt.gt.altitude(altlen)))
1900  endif ! of if (alttype.eq.'p')
1901endif ! of if (alt.ne.prev_alt)
1902!write(*,*) 'ialt_inf=',ialt_inf," altitude(ialt_inf)=",altitude(ialt_inf)
1903
1904if (sol.ne.prev_sol) then
1905  !handle special case for sol not in the time(1):time(timenlen) interval
1906  if ((sol.lt.time(1)).or.(sol.gt.time(timelen))) then
1907    itim_inf=-1
1908    itim_sup=-1
1909    ! return to main program (with value=missing_value)
1910!    write(*,*)"Problem in extraction : GCM sol"
1911    return
1912  else ! general case
1913    do i=1,timelen-1
1914      if (time(i).le.sol) then
1915        itim_inf=i
1916      else
1917        exit
1918      endif
1919    enddo
1920    itim_sup=itim_inf+1
1921  endif ! of if ((sol.lt.time(1)).or.(sol.gt.time(timenlen)))
1922endif ! of if (sol.ne.prev_sol)
1923!write(*,*) 'itim_inf=',itim_inf," time(itim_inf)=",time(itim_inf)
1924!write(*,*) 'itim_sup=',itim_sup," time(itim_sup)=",time(itim_sup)
1925
1926!================================================================
1927! 2. Interpolate
1928!================================================================
1929! check that there are no "missing_value" in the field() elements we need
1930! otherwise return to main program (with value=missing_value)
1931if (field(ilon_inf,ilat_inf,ialt_inf,itim_inf).eq.missing_value) then
1932!  write(*,*)"Error 1 in extraction"
1933  return
1934 endif
1935if (field(ilon_inf,ilat_inf,ialt_inf,itim_sup).eq.missing_value) then
1936!  write(*,*)"Error 2 in extraction"
1937  return
1938 endif
1939if (field(ilon_inf,ilat_inf,ialt_sup,itim_inf).eq.missing_value) then
1940!  write(*,*)"Error 3 in extraction"
1941  return
1942 endif
1943if (field(ilon_inf,ilat_inf,ialt_sup,itim_sup).eq.missing_value) then
1944!  write(*,*)"Error 4 in extraction"
1945  return
1946 endif
1947if (field(ilon_inf,ilat_sup,ialt_inf,itim_inf).eq.missing_value) then
1948!  write(*,*)"Error 5 in extraction"
1949  return
1950 endif
1951if (field(ilon_inf,ilat_sup,ialt_inf,itim_sup).eq.missing_value) then
1952!  write(*,*)"Error 6 in extraction"
1953  return
1954 endif
1955if (field(ilon_inf,ilat_sup,ialt_sup,itim_inf).eq.missing_value) then
1956!  write(*,*)"Error 7 in extraction"
1957  return
1958 endif
1959if (field(ilon_inf,ilat_sup,ialt_sup,itim_sup).eq.missing_value) then
1960!  write(*,*)"Error 8 in extraction"
1961  return
1962 endif
1963if (field(ilon_sup,ilat_inf,ialt_inf,itim_inf).eq.missing_value) then
1964!  write(*,*)"Error 9 in extraction"
1965  return
1966 endif
1967if (field(ilon_sup,ilat_inf,ialt_inf,itim_sup).eq.missing_value) then
1968!  write(*,*)"Error 10 in extraction"
1969  return
1970 endif
1971if (field(ilon_sup,ilat_inf,ialt_sup,itim_inf).eq.missing_value) then
1972!  write(*,*)"Error 11 in extraction"
1973  return
1974 endif
1975if (field(ilon_sup,ilat_inf,ialt_sup,itim_sup).eq.missing_value) then
1976!  write(*,*)"Error 12 in extraction"
1977  return
1978 endif
1979if (field(ilon_sup,ilat_sup,ialt_inf,itim_inf).eq.missing_value) then
1980!  write(*,*)"Error 13 in extraction"
1981  return
1982 endif
1983if (field(ilon_sup,ilat_sup,ialt_inf,itim_sup).eq.missing_value) then
1984!  write(*,*)"Error 14 in extraction"
1985  return
1986 endif
1987if (field(ilon_sup,ilat_sup,ialt_sup,itim_inf).eq.missing_value) then
1988!  write(*,*)"Error 15 in extraction"
1989  return
1990 endif
1991if (field(ilon_sup,ilat_sup,ialt_sup,itim_sup).eq.missing_value) then
1992!  write(*,*)"Error 16 in extraction"
1993  return
1994 endif
1995
1996!================================================================
1997! 2.1 Linear interpolation in time
1998!================================================================
1999coeff=(sol-time(itim_inf))/(time(itim_sup)-time(itim_inf))
2000t_interp(1,1,1)=field(ilon_inf,ilat_inf,ialt_inf,itim_inf)+ &
2001                coeff*(field(ilon_inf,ilat_inf,ialt_inf,itim_sup)- &
2002                       field(ilon_inf,ilat_inf,ialt_inf,itim_inf))
2003t_interp(1,1,2)=field(ilon_inf,ilat_inf,ialt_sup,itim_inf)+ &
2004                coeff*(field(ilon_inf,ilat_inf,ialt_sup,itim_sup)- &
2005                       field(ilon_inf,ilat_inf,ialt_sup,itim_inf))
2006t_interp(1,2,1)=field(ilon_inf,ilat_sup,ialt_inf,itim_inf)+ &
2007                coeff*(field(ilon_inf,ilat_sup,ialt_inf,itim_sup)- &
2008                       field(ilon_inf,ilat_sup,ialt_inf,itim_inf))
2009t_interp(1,2,2)=field(ilon_inf,ilat_sup,ialt_sup,itim_inf)+ &
2010                coeff*(field(ilon_inf,ilat_sup,ialt_sup,itim_sup)- &
2011                       field(ilon_inf,ilat_sup,ialt_sup,itim_inf))
2012t_interp(2,1,1)=field(ilon_sup,ilat_inf,ialt_inf,itim_inf)+ &
2013                coeff*(field(ilon_sup,ilat_inf,ialt_inf,itim_sup)- &
2014                       field(ilon_sup,ilat_inf,ialt_inf,itim_inf))
2015t_interp(2,1,2)=field(ilon_sup,ilat_inf,ialt_sup,itim_inf)+ &
2016                coeff*(field(ilon_sup,ilat_inf,ialt_sup,itim_sup)- &
2017                       field(ilon_sup,ilat_inf,ialt_sup,itim_inf))
2018t_interp(2,2,1)=field(ilon_sup,ilat_sup,ialt_inf,itim_inf)+ &
2019                coeff*(field(ilon_sup,ilat_sup,ialt_inf,itim_sup)- &
2020                       field(ilon_sup,ilat_sup,ialt_inf,itim_inf))
2021t_interp(2,2,2)=field(ilon_sup,ilat_sup,ialt_sup,itim_inf)+ &
2022                coeff*(field(ilon_sup,ilat_sup,ialt_sup,itim_sup)- &
2023                       field(ilon_sup,ilat_sup,ialt_sup,itim_inf))
2024
2025!================================================================
2026! 2.2 Vertical interpolation
2027!================================================================
2028if (((varname=='rho').or.(varname=='pressure')).and.(alttype=='z')) then
2029  ! do the interpolation on the log of the quantity
2030  coeff=(alt-altitude(ialt_inf))/(altitude(ialt_sup)-altitude(ialt_inf))
2031  zt_interp(1,1)=log(t_interp(1,1,1))+coeff* &
2032                             (log(t_interp(1,1,2))-log(t_interp(1,1,1)))
2033  zt_interp(1,2)=log(t_interp(1,2,1))+coeff* &
2034                             (log(t_interp(1,2,2))-log(t_interp(1,2,1)))
2035  zt_interp(2,1)=log(t_interp(2,1,1))+coeff* &
2036                             (log(t_interp(2,1,2))-log(t_interp(2,1,1)))
2037  zt_interp(2,2)=log(t_interp(2,2,1))+coeff* &
2038                             (log(t_interp(2,2,2))-log(t_interp(2,2,1)))
2039  zt_interp(1:2,1:2)=exp(zt_interp(1:2,1:2))
2040else ! general case
2041  coeff=(alt-altitude(ialt_inf))/(altitude(ialt_sup)-altitude(ialt_inf))
2042  zt_interp(1,1)=t_interp(1,1,1)+coeff*(t_interp(1,1,2)-t_interp(1,1,1))
2043  zt_interp(1,2)=t_interp(1,2,1)+coeff*(t_interp(1,2,2)-t_interp(1,2,1))
2044  zt_interp(2,1)=t_interp(2,1,1)+coeff*(t_interp(2,1,2)-t_interp(2,1,1))
2045  zt_interp(2,2)=t_interp(2,2,1)+coeff*(t_interp(2,2,2)-t_interp(2,2,1))
2046endif
2047
2048!================================================================
2049! 2.3 Latitudinal interpolation
2050!================================================================
2051coeff=(lat-latitude(ilat_inf))/(latitude(ilat_sup)-latitude(ilat_inf))
2052yzt_interp(1)=zt_interp(1,1)+coeff*(zt_interp(1,2)-zt_interp(1,1))
2053yzt_interp(2)=zt_interp(2,1)+coeff*(zt_interp(2,2)-zt_interp(2,1))
2054
2055!================================================================
2056! 2.4 longitudinal interpolation
2057!================================================================
2058coeff=(lon-longitude(ilon_inf))/(longitude(ilon_sup)-longitude(ilon_inf))
2059value=yzt_interp(1)+coeff*(yzt_interp(2)-yzt_interp(1))
2060
2061end subroutine extraction
2062
2063!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2064
2065subroutine inidim(outfid,lonlen,latlen,altlen,timelen,lon,lat,alt,time,units_alt,&
2066                     londimid,latdimid,altdimid,timedimid)
2067!================================================================
2068! Purpose:
2069! Initialize a data file (NetCDF format)
2070!================================================================
2071! Remarks:
2072! The NetCDF file remains open
2073!================================================================
2074use netcdf ! NetCDF definitions
2075implicit none
2076!================================================================
2077! Arguments:
2078!================================================================
2079integer, intent(in):: outfid
2080! outfid: [netcdf] file ID
2081integer, intent(in):: lonlen
2082! lonlen: longitude length (# of longitude values)
2083integer, intent(in):: latlen
2084! latlen: latitude length (# of latitude values)
2085integer, intent(in):: altlen
2086! altlen: altitude length (# of altitude values)
2087integer, intent(in):: timelen
2088! timelen: time length (# of time values)
2089real, intent(in):: lon(lonlen)
2090! lon(): longitude
2091real, intent(in):: lat(latlen)
2092! lat(): latitude
2093real, intent(in):: alt(altlen)
2094! alt(): altitude
2095real, intent(in):: time(timelen)
2096! time(): time (Ls)
2097character(len=1), intent(in) :: units_alt
2098! units_alt: altitude coord. type:'z' (altitude, m) 'p' (pressure, Pa)
2099integer,intent(inout):: londimid
2100! londimid: [netcdf] lon() (i.e.: longitude) ID in MCS and output files (they are the same)
2101integer,intent(inout) :: latdimid
2102! latdimid: [netcdf] lat() ID in MCS and output files (they are the same)
2103integer,intent(inout):: altdimid
2104! altdimid: [netcdf] alt() ID in MCS and output files (they are the same)
2105integer,intent(inout):: timedimid
2106! timedimid: [netcdf] time() ID in MCS and output files (they are the same)
2107
2108!================================================================
2109! Local variables:
2110!================================================================
2111integer :: lonvarid,latvarid,altvarid,timevarid,status
2112! *varid: [netcdf] ID of a variable
2113! status: [netcdf]  return error code (from called subroutines)
2114character(len=256) :: error_text
2115integer :: d ! loop index on dimensions ID
2116
2117!===============================================================
2118! 1. Define/write "dimensions" in the same order than MCS file
2119!    and get their IDs
2120!================================================================
2121do d=1,4
2122  if (altdimid.eq.d) then
2123    status=nf90_def_dim(outfid, "altitude", altlen, altdimid)
2124    error_text="Error: could not define the altitude dimension in the outfile"
2125    call status_check(status,error_text)
2126  else if (timedimid.eq.d) then
2127    status=nf90_def_dim(outfid, "time", timelen, timedimid)
2128    error_text="Error: could not define the time dimension in the outfile"
2129    call status_check(status,error_text)
2130  else if (latdimid.eq.d) then
2131    status=nf90_def_dim(outfid, "latitude", latlen, latdimid)
2132    error_text="Error: could not define the latitude dimension in the outfile"
2133    call status_check(status,error_text)
2134  else if (londimid.eq.d) then
2135    status=nf90_def_dim(outfid, "longitude", lonlen, londimid)
2136    error_text="Error: could not define the longitude dimension in the outfile"
2137    call status_check(status,error_text)
2138  endif
2139enddo
2140
2141!================================================================
2142! 2. Define "variables" and their attributes
2143!================================================================
2144!================================================================
2145! 2.1 Write "longitude" (data and attributes)
2146!================================================================
2147
2148! Insert the definition of the variable
2149status=nf90_def_var(outfid,"longitude",nf90_float,(/londimid/),lonvarid)
2150error_text="Error: could not define the longitude variable in the outfile"
2151call status_check(status,error_text)
2152
2153! Write the attributes
2154status=nf90_put_att(outfid,lonvarid,"long_name","longitude")
2155error_text="Error: could not put the long_name attribute for the longitude variable in the outfile"
2156call status_check(status,error_text)
2157
2158status=nf90_put_att(outfid,lonvarid,"units","degrees_east")
2159error_text="Error: could not put the units attribute for the longitude variable in the outfile"
2160call status_check(status,error_text)
2161
2162!================================================================
2163! 2.2 "latitude"
2164!================================================================
2165
2166! Insert the definition of the variable
2167status=nf90_def_var(outfid,"latitude",nf90_float,(/latdimid/),latvarid)
2168error_text="Error: could not define the latitude variable in the outfile"
2169call status_check(status,error_text)
2170
2171! Write the attributes
2172status=nf90_put_att(outfid,latvarid,"long_name","latitude")
2173error_text="Error: could not put the long_name attribute for the latitude variable in the outfile"
2174call status_check(status,error_text)
2175
2176status=nf90_put_att(outfid,latvarid,"units","degrees_north")
2177error_text="Error: could not put the units attribute for the latitude variable in the outfile"
2178call status_check(status,error_text)
2179
2180!================================================================
2181! 2.3 Write "altitude" (data and attributes)
2182!================================================================
2183
2184! Insert the definition of the variable
2185status=nf90_def_var(outfid,"altitude",nf90_float,(/altdimid/),altvarid)
2186error_text="Error: could not define the altitude variable in the outfile"
2187call status_check(status,error_text)
2188
2189! Write the attributes
2190if (units_alt.eq.'p') then ! pressure coordinate
2191  status=nf90_put_att(outfid,altvarid,"long_name","pressure")
2192  error_text="Error: could not put the long_name attribute for the altitude variable in the outfile"
2193  call status_check(status,error_text)
2194
2195  status=nf90_put_att(outfid,altvarid,'units',"Pa")
2196  error_text="Error: could not put the units attribute for the altitude variable in the outfile"
2197  call status_check(status,error_text)
2198
2199  status=nf90_put_att(outfid,altvarid,'positive',"down")
2200  error_text="Error: could not put the positive attribute for the altitude variable in the outfile"
2201  call status_check(status,error_text)
2202
2203  status=nf90_put_att(outfid,altvarid,'comment',&
2204  "The vertical variable is in fact pressure, not altitude. We just call it altitude for easy reading in Ferret and Grads.")
2205  error_text="Error: could not put the comment attribute for the altitude variable in the outfile"
2206  call status_check(status,error_text)
2207
2208else if (units_alt.eq.'z') then ! altitude coordinate
2209  status=nf90_put_att(outfid,altvarid,"long_name","altitude")
2210  error_text="Error: could not put the long_name attribute for the altitude variable in the outfile"
2211  call status_check(status,error_text)
2212
2213  status=nf90_put_att(outfid,altvarid,'units',"m")
2214  error_text="Error: could not put the units attribute for the altitude variable in the outfile"
2215  call status_check(status,error_text)
2216
2217  status=nf90_put_att(outfid,altvarid,'positive',"up")
2218  error_text="Error: could not put the positive attribute for the altitude variable in the outfile"
2219  call status_check(status,error_text)
2220
2221else
2222  write(*,*)"I do not understand this unit type ",units_alt," for outfile altitude!"
2223  stop
2224end if
2225
2226!================================================================
2227! 2.4 "time"
2228!================================================================
2229
2230! Insert the definition of the variable
2231status=nf90_def_var(outfid,"time",nf90_float,(/timedimid/),timevarid)
2232error_text="Error: could not define the time variable in the outfile"
2233call status_check(status,error_text)
2234
2235! Write the attributes
2236status=nf90_put_att(outfid,timevarid,"long_name","Solar longitude")
2237error_text="Error: could not put the long_name attribute for the time variable in the outfile"
2238call status_check(status,error_text)
2239
2240status=nf90_put_att(outfid,timevarid,"units","days since 0000-01-1 00:00:00")
2241error_text="Error: could not put the units attribute for the time variable in the outfile"
2242call status_check(status,error_text)
2243
2244status=nf90_put_att(outfid,timevarid,"comment",&
2245"Units is in fact degrees, but set to a dummy value of days for compatibility with Ferret and Grads.")
2246error_text="Error: could not put the comment attribute for the time variable in the outfile"
2247call status_check(status,error_text)
2248
2249!================================================================
2250! 2.5 End netcdf define mode
2251!================================================================
2252status=nf90_enddef(outfid)
2253error_text="Error: could not end the define mode of the outfile"
2254call status_check(status,error_text)
2255
2256!================================================================
2257! 3. Write "variables" (data of the dimension variables)
2258!================================================================
2259! "time"
2260status=nf90_put_var(outfid,timevarid,time)
2261error_text="Error: could not write the time variable's data in the outfile"
2262call status_check(status,error_text)
2263
2264! "latitude"
2265status=nf90_put_var(outfid,latvarid,lat)
2266error_text="Error: could not write the latitude variable's data in the outfile"
2267call status_check(status,error_text)
2268
2269! "longitude"
2270status=nf90_put_var(outfid,lonvarid,lon)
2271error_text="Error: could not write the longitude variable's data in the outfile"
2272call status_check(status,error_text)
2273
2274! "altitude"
2275status=nf90_put_var(outfid,altvarid,alt)
2276error_text="Error: could not write the altitude variable's data in the outfile"
2277call status_check(status,error_text)
2278
2279end subroutine inidim
2280
2281!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2282
2283subroutine ls2sol(ls,sol)
2284
2285implicit none
2286!================================================================
2287!  Arguments:
2288!================================================================
2289real,intent(in) :: ls
2290real,intent(out) :: sol
2291
2292!================================================================
2293!  Local:
2294!================================================================
2295double precision xref,zx0,zteta,zz
2296!xref: mean anomaly, zteta: true anomaly, zx0: eccentric anomaly
2297double precision year_day
2298double precision peri_day,timeperi,e_elips
2299double precision pi,degrad
2300parameter (year_day=668.6d0) ! number of sols in a martian year
2301parameter (peri_day=485.35d0) ! date (in sols) of perihelion
2302!timeperi: 2*pi*( 1 - Ls(perihelion)/ 360 ); Ls(perihelion)=250.99
2303parameter (timeperi=1.90258341759902d0)
2304parameter (e_elips=0.0934d0)  ! eccentricity of orbit
2305parameter (pi=3.14159265358979d0)
2306parameter (degrad=57.2957795130823d0)
2307
2308      if (abs(ls).lt.1.0e-5) then
2309         if (ls.ge.0.0) then
2310            sol = 0.0
2311         else
2312            sol = real(year_day)
2313         end if
2314         return
2315      end if
2316
2317      zteta = ls/degrad + timeperi
2318      zx0 = 2.0*datan(dtan(0.5*zteta)/dsqrt((1.+e_elips)/(1.-e_elips)))
2319      xref = zx0-e_elips*dsin(zx0)
2320      zz = xref/(2.*pi)
2321      sol = real(zz*year_day + peri_day)
2322      if (sol.lt.0.0) sol = sol + real(year_day)
2323      if (sol.ge.year_day) sol = sol - real(year_day)
2324
2325
2326end subroutine ls2sol
2327
2328!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2329
2330subroutine gen_sol_list(solcount,int_sol_list,LTcount,LTave,LTmax,LTmin,lon,f_LT,dayornight,&
2331                        sol_list)
2332!================================================================
2333! Purpose:
2334! Generate a list that is the combination of two lists :
2335! - int_sol_list, which is a list of integer values of sol
2336! - LT_list, which contains a number LTcount of LT values in the
2337!   interval [LTmin;LTmax] which are evenly distributed around
2338!   LTave (so that their average is LTave)
2339!================================================================
2340
2341implicit none
2342!================================================================
2343! Arguments:
2344!================================================================
2345integer, intent(in) :: solcount ! nb of integer values of sol
2346real, intent(in) :: int_sol_list(solcount) ! list of the integer values of sol
2347integer, intent(in) :: LTcount ! nb of LT per sol to be interpolated
2348real, intent(in) :: LTave ! average of LT
2349real, intent(in) :: LTmax, LTmin ! bounds of the LT interval for the interpolation
2350real, intent(in) :: lon ! longitude value for the transformation into a sol value at lon=0°
2351external f_LT ! function that changes LT interval for night LT
2352real f_LT
2353character (len=10), intent(in) :: dayornight ! to know if we have day or night values
2354
2355real, intent(out) :: sol_list(solcount*LTcount) ! all the sol values at lon=0° to interpolate
2356
2357!================================================================
2358! Local variables:
2359!================================================================
2360integer :: N
2361integer :: a,b,c ! loop iteration indexes
2362real :: LT_list(LTcount)
2363
2364N = floor(LTcount/2.)
2365
2366!================================================================
2367! 1. Filling of LT_list
2368!================================================================
2369SELECT CASE (dayornight)
2370CASE ("dayside")
2371  if (abs(LTave-LTmax).le.abs(LTave-LTmin)) then ! LTave is closer to LTmax than to LTmin
2372  do a=1,N
2373    LT_list(a)=LTave+a*abs(LTave-LTmax)/(N+1)
2374    LT_list(N+a)=LTave-a*abs(LTave-LTmax)/(N+1)
2375  enddo
2376else ! LTave is closer to LTmin than to LTmax
2377  do a=1,N
2378    LT_list(a)=LTave+a*abs(LTave-LTmin)/(N+1)
2379    LT_list(N+a)=LTave-a*abs(LTave-LTmin)/(N+1)
2380  enddo
2381endif
2382CASE ("nightside")
2383  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
2384    do a=1,N
2385      LT_list(a)=LTave+a*abs(f_LT(LTave)-f_LT(LTmax))/(N+1)
2386      LT_list(a)=mod(LT_list(a),24.) ! reput the LT in a [0;24[ interval if needed
2387      LT_list(N+a)=LTave-a*abs(f_LT(LTave)-f_LT(LTmax))/(N+1)
2388      LT_list(N+a)=mod(LT_list(N+a),24.)
2389    enddo
2390  else ! LTave is closer to LTmin than to LTmax
2391    do a=1,N
2392      LT_list(a)=LTave+a*abs(f_LT(LTave)-f_LT(LTmin))/(N+1)
2393      LT_list(a)=mod(LT_list(a),24.)
2394      LT_list(N+a)=LTave-a*abs(f_LT(LTave)-f_LT(LTmin))/(N+1)
2395      LT_list(N+a)=mod(LT_list(N+a),24.)
2396    enddo
2397  endif
2398END SELECT
2399
2400if (mod(LTcount,2).eq.1) then ! if LTcount is an odd number
2401  LT_list(LTcount)=LTave ! add LTave to the list
2402endif
2403
2404!================================================================
2405! 2. Combination of int_sol_list & LT_list into sol_list
2406!================================================================
2407c=1
2408do a=1,solcount
2409  do b=1,LTcount
2410    sol_list(c)=int_sol_list(a)+(LT_list(b)-lon/15.)/24.
2411    c=c+1
2412  enddo
2413enddo
2414
2415end subroutine gen_sol_list
2416
2417!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2418
2419subroutine status_check(status,error_text)
2420
2421use netcdf
2422implicit none
2423!================================================================
2424!  Arguments:
2425!================================================================
2426integer,intent(in) :: status
2427character(len=256),intent(in) :: error_text
2428
2429if (status.ne.nf90_noerr) then
2430  write(*,*)trim(error_text)
2431  write(*,*)trim(nf90_strerror(status))
2432  stop
2433endif
2434
2435end subroutine status_check
2436
2437!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2438
2439real function LTmod(LT)
2440!================================================================
2441! Purpose:
2442! For night local times management, replace hours 
2443! from a [0;24[ interval to a [-12;12[ interval in which
2444! midnight = 0 (in order to ensure continuity when comparing
2445! night local times)
2446!================================================================
2447implicit none
2448real,intent(in) :: LT
2449
2450LTmod = 2*mod(LT,12.)-LT
2451return
2452end function LTmod
Note: See TracBrowser for help on using the repository browser.