source: IOIPSL/trunk/src/flincom.f90

Last change on this file was 6058, checked in by jgipsl, 2 years ago

Add error checking after read of attributes related to time axis. Do nothing if there are errors. This is needed for the file ECDYN.nc without time axis, file read by create_etat0_limit in LMDZ. Note that it is not new that this file is read by flincom but maybe the debug options was not tested for this case before.

Done by Adriana Sima, LMD

  • Property svn:keywords set to Id
File size: 60.9 KB
Line 
1MODULE flincom
2!-
3!$Id$
4!-
5! This software is governed by the CeCILL license
6! See IOIPSL/IOIPSL_License_CeCILL.txt
7!---------------------------------------------------------------------
8  USE netcdf
9!-
10  USE calendar,  ONLY : ju2ymds, ymds2ju, ioconf_calendar
11  USE errioipsl, ONLY : histerr, ipslout,ipslerr,ipsldbg
12  USE stringop,  ONLY : strlowercase
13!-
14  IMPLICIT NONE
15!-
16  PRIVATE
17  PUBLIC :: flinput, flincre, flinget, flinclo, &
18            flinopen, flininfo, flininspect, flinquery_var
19!-
20  INTERFACE flinopen
21!---------------------------------------------------------------------
22!- The "flinopen" routines will open an input file
23!-
24!- INPUT
25!-
26!- filename  : Name of the netCDF file to be opened
27!-
28!- iideb     : index i for zoom     !
29!- iilen     : length  of  zoom     !   for
30!- jjdeb     : index j for zoom     !   zoom
31!- jjlen     : length  of  zoom     !
32!-
33!- do_test   : A flag that enables the testing of the content
34!-             of the file against the input from the model
35!-
36!- INPUT if do_test=TRUE      OUTPUT else
37!-
38!- iim       : size in the x direction in the file (longitude)
39!- jjm       : size in the y direction
40!- llm       : number of levels
41!-             (llm = 0 means no axis to be expected)
42!- lon       : array of (iilen,jjlen) (zoom), or (iim,jjm) (no zoom),
43!-             that contains the longitude of each point
44!- lat       : same for latitude
45!- lev       : An array of llm for the latitude
46!-
47!- WARNING :
48!- In the case of do_test=FALSE it is for the user to check
49!- that the dimensions of lon lat and lev are correct when passed to
50!- flinopen. This can be done after the call when iim and jjm have
51!- been retrieved from the netCDF file. In F90 this problem will
52!- be solved with an internal assign
53!- IF iim, jjm, llm or ttm are parameters in the calling program and
54!- you use the option do_test=FALSE it will create a segmentation fault
55!-
56!-  OUTPUT
57!-
58!-  ttm       : size of time axis
59!-  itaus     : Time steps within this file
60!-  date0     : Julian date at which itau = 0
61!-  dt        : length of the time steps of the data
62!-  fid       : returned file ID which is later used to read the data
63!---------------------------------------------------------------------
64    MODULE PROCEDURE flinopen_zoom2d, flinopen_nozoom
65  END INTERFACE
66!-
67  INTERFACE flinput
68!---------------------------------------------------------------------
69!- The "flinput" routines will put a variable
70!- on the netCDF file created by flincre.
71!- If the sizes of the axis do not match the one of the IDs
72!- then a new axis is created.
73!- That is we loose the possibility of writting hyperslabs of data.
74!-
75!- Again here if iim = jjm = llm = ttm = 0
76!- then a global attribute is added to the file.
77!-
78!- INPUT
79!-
80!- fid      : Identification of the file in which we will write
81!- varname  : Name of variable to be written
82!- iim      : size in x of variable
83!- nlonid   : ID of x axis which could fit for this axis
84!- jjm      : size in y of variable
85!- nlatid   : ID of y axis which could fit for this axis
86!- llm      : size in z of variable
87!- zdimid   : ID of z axis which could fit for this axis
88!- ttm      : size in t of variable
89!- tdimid   : ID of t axis which could fit for this axis
90!-
91!- OUTPUT
92!-
93!- NONE
94!---------------------------------------------------------------------
95    MODULE PROCEDURE flinput_r4d, flinput_r3d, flinput_r2d, &
96                     flinput_r1d, flinput_scal
97  END INTERFACE
98!-
99  INTERFACE flinget
100    MODULE PROCEDURE flinget_r4d, flinget_r3d, flinget_r2d, &
101                     flinget_r1d, flinget_scal, &
102                     flinget_r4d_zoom2d, flinget_r3d_zoom2d, &
103                     flinget_r2d_zoom2d
104  END INTERFACE
105!-
106! This is the data we keep on each file we open
107!-
108  INTEGER, PARAMETER :: nbfile_max = 200
109  INTEGER, SAVE :: nbfiles = 0
110  INTEGER, SAVE :: ncids(nbfile_max), ncnbd(nbfile_max), &
111                   ncfunli(nbfile_max), ncnba(nbfile_max)
112  INTEGER, SAVE :: ncnbva(nbfile_max), ncdims(nbfile_max,4)
113  LOGICAL, SAVE :: ncfileopen(nbfile_max)=.FALSE.
114!-
115  INTEGER, SAVE :: cind_vid, cind_fid, cind_len
116  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: cindex
117!-
118  INTEGER,DIMENSION(4) :: w_sta, w_len, w_dim
119!-
120CONTAINS
121!-
122!===
123!-
124SUBROUTINE flincre &
125  (filename, iim1, jjm1, lon1, lat1, llm1, lev1, ttm1, itaus, &
126   time0, dt, fid_out, nlonid1, nlatid1, zdimid1, tdimid1)
127!---------------------------------------------------------------------
128!- This is a "low level" subroutine for opening netCDF files wich
129!- contain the major coordinate system of the model.
130!- Other coordinates needed for other variables
131!- will be added as they are needed.
132!-
133!- INPUT
134!-
135!- filename    : Name of the file to be created
136!- iim1, jjm1  : Horizontal size of the grid
137!-               which will be stored in the file
138!- lon1, lat1  : Horizontal grids
139!- llm1        : Size of the vertical grid
140!- lev1        : Vertical grid
141!- ttm1        : Size of time axis
142!- itaus       : time steps on the time axis
143!- time0       : Time in julian days at which itau = 0
144!- dt          : time step in seconds between itaus
145!-               (one step of itau)
146!-
147!- OUTPUT
148!-
149!- fid         : File identification
150!- nlonid1     : Identification of longitudinal axis
151!- nlatid1     : Identification of latitudinal axis
152!- zdimid1     : ID of vertical axis
153!- tdimid1     : ID of time axis
154!---------------------------------------------------------------------
155  IMPLICIT NONE
156!-
157! ARGUMENTS
158!-
159  CHARACTER(LEN=*) :: filename
160  INTEGER :: iim1, jjm1, llm1, ttm1
161  REAL :: lon1(iim1,jjm1)
162  REAL :: lat1(iim1,jjm1)
163  REAL :: lev1(llm1)
164  INTEGER :: itaus(ttm1)
165  REAL :: time0
166  REAL :: dt
167  INTEGER :: fid_out, zdimid1, nlonid1, nlatid1, tdimid1
168!-
169! LOCAL
170!-
171  INTEGER :: iret, lll, fid
172  INTEGER :: lonid, latid, levid, timeid
173  INTEGER :: year, month, day
174  REAL :: sec
175  CHARACTER(LEN=250):: name
176!-
177  LOGICAL :: l_dbg
178!---------------------------------------------------------------------
179  CALL ipsldbg (old_status=l_dbg)
180
181  lll = LEN_TRIM(filename)
182  IF (filename(lll-2:lll) /= '.nc') THEN
183    name=filename(1:lll)//'.nc'
184  ELSE
185    name=filename(1:lll)
186  ENDIF
187!-
188  iret = NF90_CREATE (name, NF90_CLOBBER, fid)
189!-
190  iret = NF90_DEF_DIM (fid, 'x',     iim1, nlonid1)
191  iret = NF90_DEF_DIM (fid, 'y',     jjm1, nlatid1)
192  iret = NF90_DEF_DIM (fid, 'lev',   llm1, zdimid1)
193  iret = NF90_DEF_DIM (fid, 'tstep', ttm1, tdimid1)
194!-
195! Vertical axis
196!-
197  IF (l_dbg) WRITE(ipslout,*) 'flincre Vertical axis'
198!-
199  iret = NF90_DEF_VAR (fid, 'lev', NF90_FLOAT, zdimid1, levid)
200  iret = NF90_PUT_ATT (fid, levid, 'units',     '-')
201  iret = NF90_PUT_ATT (fid, levid, 'title',     'levels')
202  iret = NF90_PUT_ATT (fid, levid, 'long_name', 'Sigma Levels')
203!-
204! Time axis
205!-
206  IF (l_dbg) WRITE(ipslout,*) 'flincre time axis'
207!-
208  iret = NF90_DEF_VAR (fid, 'tstep', NF90_FLOAT, tdimid1, timeid)
209  iret = NF90_PUT_ATT (fid, timeid, 'units',     '-')
210  iret = NF90_PUT_ATT (fid, timeid, 'title',     'time')
211  iret = NF90_PUT_ATT (fid, timeid, 'long_name', 'time steps')
212!-
213! The longitude
214!-
215  IF (l_dbg) WRITE(ipslout,*) 'flincre Longitude axis'
216!-
217  iret = NF90_DEF_VAR (fid, "nav_lon", NF90_FLOAT, &
218                       (/ nlonid1, nlatid1 /), lonid)
219  iret = NF90_PUT_ATT (fid, lonid, 'units', "degrees_east")
220  iret = NF90_PUT_ATT (fid, lonid, 'title', "Longitude")
221  iret = NF90_PUT_ATT (fid, lonid, 'nav_model', &
222                       "Lambert projection of PROMES")
223  iret = NF90_PUT_ATT (fid, lonid, 'valid_min', &
224                       REAL(MINVAL(lon1),KIND=4))
225  iret = NF90_PUT_ATT (fid, lonid, 'valid_max', &
226                       REAL(MAXVAL(lon1),KIND=4))
227!-
228! The Latitude
229!-
230  IF (l_dbg) WRITE(ipslout,*) 'flincre Latitude axis'
231!-
232  iret = NF90_DEF_VAR (fid, "nav_lat", NF90_FLOAT, &
233                     (/ nlonid1, nlatid1 /), latid)
234  iret = NF90_PUT_ATT (fid, latid, 'units', "degrees_north")
235  iret = NF90_PUT_ATT (fid, latid, 'title', "Latitude")
236  iret = NF90_PUT_ATT (fid, latid, 'nav_model', &
237                       "Lambert projection of PROMES")
238  iret = NF90_PUT_ATT (fid, latid, 'valid_min', &
239                       REAL(MINVAL(lat1),KIND=4))
240  iret = NF90_PUT_ATT (fid, latid, 'valid_max', &
241                       REAL(MAXVAL(lat1),KIND=4))
242!-
243! The time coordinates
244!-
245  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', &
246                       REAL(dt,KIND=4))
247!-
248  CALL ju2ymds (time0, year, month, day, sec)
249!-
250  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'year0',  REAL(year,KIND=4))
251  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'month0', REAL(month,KIND=4))
252  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'day0',   REAL(day,KIND=4))
253  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'sec0',   REAL(sec,KIND=4))
254!-
255  iret = NF90_ENDDEF (fid)
256!-
257  IF (l_dbg) WRITE(ipslout,*) 'flincre Variable'
258!-
259  iret = NF90_PUT_VAR (fid, levid, lev1(1:llm1))
260!-
261  IF (l_dbg) WRITE(ipslout,*) 'flincre Time Variable'
262!-
263  iret = NF90_PUT_VAR (fid, timeid, REAL(itaus(1:ttm1)))
264!-
265  IF (l_dbg) WRITE(ipslout,*) 'flincre Longitude'
266!-
267  iret = NF90_PUT_VAR (fid, lonid, lon1(1:iim1,1:jjm1))
268!-
269  IF (l_dbg) WRITE(ipslout,*) 'flincre Latitude'
270!-
271  iret = NF90_PUT_VAR (fid, latid, lat1(1:iim1,1:jjm1))
272!-
273! Keep all this information
274!-
275  nbfiles = nbfiles+1
276!-
277  IF (nbfiles > nbfile_max) THEN
278    CALL histerr (3,'flincre', &
279     'Too many files. Please increase nbfil_max', &
280     'in program flincom.F90.',' ')
281  ENDIF
282!-
283  ncids(nbfiles) = fid
284  ncnbd(nbfiles) = 4
285!-
286  ncdims(nbfiles,1:4) = (/ iim1, jjm1, llm1, ttm1 /)
287!-
288  ncfunli(nbfiles) = -1
289  ncnba(nbfiles)   =  4
290  ncnbva(nbfiles)  =  0
291  ncfileopen(nbfiles) = .TRUE.
292!-
293  fid_out = nbfiles
294!---------------------
295END SUBROUTINE flincre
296!-
297!===
298!-
299SUBROUTINE flinopen_zoom2d &
300  (filename, iideb, iilen, jjdeb, jjlen, do_test, &
301  iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
302!---------------------------------------------------------------------
303  IMPLICIT NONE
304!-
305! ARGUMENTS
306!-
307  CHARACTER(LEN=*) :: filename
308  LOGICAL :: do_test
309  INTEGER :: iim, jjm, llm, ttm, iideb, iilen, jjdeb, jjlen
310  REAL :: lon(iilen,jjlen), lat(iilen,jjlen), lev(llm)
311  INTEGER :: itaus(ttm)
312  REAL :: date0, dt
313  INTEGER :: fid_out
314!-
315  LOGICAL :: l_dbg
316!---------------------------------------------------------------------
317  CALL ipsldbg (old_status=l_dbg)
318
319  IF (l_dbg) WRITE (*,*) ' iideb, iilen, jjdeb, jjlen, iim, jjm ', &
320                           iideb, iilen, jjdeb, jjlen, iim, jjm
321  IF (l_dbg) WRITE (*,*) ' lon ', lon(1,1), lon(iilen,jjlen)
322  IF (l_dbg) WRITE (*,*) ' lat ', lat(1,1), lat(iilen,jjlen)
323!-
324  CALL flinopen_work &
325    (filename, iideb, iilen, jjdeb, jjlen, do_test, &
326     iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
327!-----------------------------
328END SUBROUTINE flinopen_zoom2d
329!-
330!===
331!-
332SUBROUTINE flinopen_nozoom &
333  (filename, do_test, iim, jjm, llm, lon, lat, lev, ttm, &
334   itaus, date0, dt, fid_out)
335!---------------------------------------------------------------------
336  IMPLICIT NONE
337!-
338! ARGUMENTS
339!-
340  CHARACTER(LEN=*) :: filename
341  LOGICAL :: do_test
342  INTEGER :: iim, jjm, llm, ttm
343  REAL :: lon(iim,jjm), lat(iim,jjm), lev(llm)
344  INTEGER :: itaus(ttm)
345  REAL :: date0, dt
346  INTEGER :: fid_out
347  INTEGER :: iimc, jjmc
348!---------------------------------------------------------------------
349  iimc=iim
350  jjmc=jjm
351  CALL flinopen_work &
352    (filename, 1, iimc, 1, jjmc, do_test, &
353     iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
354!-------------------------
355END SUBROUTINE flinopen_nozoom
356!-
357!===
358!-
359SUBROUTINE flinopen_work &
360  (filename, iideb, iilen, jjdeb, jjlen, do_test, &
361   iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
362!---------------------------------------------------------------------
363  IMPLICIT NONE
364!-
365! ARGUMENTS
366!-
367  CHARACTER(LEN=*) :: filename
368  LOGICAL :: do_test
369  INTEGER :: iim, jjm, llm, ttm, iideb, iilen, jjdeb, jjlen
370  REAL :: lon(iilen,jjlen), lat(iilen,jjlen), lev(llm)
371  INTEGER :: itaus(ttm)
372  REAL :: date0, dt
373  INTEGER :: fid_out
374!-
375! LOCAL
376!-
377  REAL, PARAMETER :: eps = 1.e-4
378!-
379  INTEGER :: iret, nberr, vid, fid, nbdim, i, iilast, jjlast
380  INTEGER :: gdtt_id, old_id, iv, gdtmaf_id
381  CHARACTER(LEN=250) :: name
382  CHARACTER(LEN=80) :: units, calendar
383  INTEGER :: tmp_iim, tmp_jjm, tmp_llm, tmp_ttm
384  REAL :: x_first, x_last
385  INTEGER :: year, month, day
386  REAL :: r_year, r_month, r_day
387  INTEGER :: year0, month0, day0, hours0, minutes0, seci
388  REAL :: sec, sec0
389  CHARACTER :: strc
390!-
391  REAL,DIMENSION(:),ALLOCATABLE :: vec_tmp
392!-
393  LOGICAL :: open_file
394  LOGICAL :: l_dbg
395!---------------------------------------------------------------------
396  CALL ipsldbg (old_status=l_dbg)
397
398  iilast = iideb+iilen-1
399  jjlast = jjdeb+jjlen-1
400  IF (l_dbg) WRITE (*,*) &
401    ' flinopen_work zoom 2D information '// &
402    ' iideb, iilen, iilast, jjdeb, jjlen, jjlast ', &
403      iideb, iilen, iilast, jjdeb, jjlen, jjlast
404!-
405! 1.0 get all infos on the file
406!-
407! Either the fid_out has not been initialized (0 or very large)
408! then we have to open anyway. Else we only need to open the file
409! if it has not been opened before.
410!-
411  IF ( (fid_out < 1).OR.(fid_out > nbfile_max) ) THEN
412    open_file = .TRUE.
413  ELSE IF (.NOT.ncfileopen(fid_out)) THEN
414    open_file = .TRUE.
415  ELSE
416    open_file = .FALSE.
417  ENDIF
418!-
419  IF (open_file) THEN
420    CALL flininfo (filename,tmp_iim,tmp_jjm,tmp_llm,tmp_ttm,fid_out)
421  ELSE
422!-- The user has already opened the file
423!-- and we trust that he knows the dimensions
424    tmp_iim = iim
425    tmp_jjm = jjm
426    tmp_llm = llm
427    tmp_ttm = ttm
428  ENDIF
429!-
430  IF (l_dbg) &
431    WRITE(ipslout,*) 'OUT OF flininfo :',tmp_iim,tmp_jjm,tmp_llm,tmp_ttm
432!-
433  fid = ncids(fid_out)
434!-
435! 2.0 get the sizes and names of the different coordinates
436!     and do a first set of verification.
437!-
438! 2.2 We test the axis if we have to.
439!-
440  IF (l_dbg) &
441    WRITE(ipslout,*) 'flininfo 2.2 We test if we have to test : ',do_test
442!-
443  IF (do_test) THEN
444    IF      (iim /= tmp_iim) THEN
445      CALL histerr (3,'flinopen', &
446        'file '//filename//' does not have the ', &
447        'required dimension in x direction (longitude)',' ')
448    ELSE IF (jjm /= tmp_jjm) THEN
449      CALL histerr (3,'flinopen', &
450        'file '//filename//' does not have the ', &
451        'required dimension in y direction (latitude)',' ')
452    ELSE IF ( llm /= tmp_llm .AND. llm > 0 ) THEN
453      CALL histerr (3,'flinopen', &
454        'file '//filename//' does not have the ', &
455        'required dimension in the vertical',' ')
456    ENDIF
457  ELSE
458!---
459!-- 2.3 Else the sizes of the axes are returned to the user
460!---
461    IF (l_dbg) WRITE(ipslout,*) 'flinopen 2.3 Else sizes are returned'
462!---
463    iim = tmp_iim
464    jjm = tmp_jjm
465    llm = tmp_llm
466  ENDIF
467!-
468  ttm = tmp_ttm
469!-
470! 3.0 Check if we are realy talking about the same coodinate system
471!     if not then we get the lon, lat and lev variables from the file
472!-
473  IF (l_dbg) WRITE(ipslout,*) 'flinopen 3.0 we are realy talking'
474!-
475  IF (do_test) THEN
476!---
477    CALL flinfindcood (fid_out, 'lon', vid, nbdim)
478    iret = NF90_GET_VAR (fid, vid, x_first, start=(/ iideb, jjdeb /))
479    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
480!---
481    IF (l_dbg) &
482      WRITE(ipslout,*) 'from file lon first and last, modulo 360. ', &
483        x_first, x_last, MODULO(x_first,360.), MODULO(x_last,360.)
484    IF (l_dbg) &
485      WRITE(ipslout,*) 'from model lon first and last, modulo 360. ', &
486        lon(1,1),lon(iilen,jjlen), &
487        MODULO(lon(1,1),360.), MODULO(lon(iilen,jjlen),360.)
488    IF (    (ABS( MODULO(x_first,360.) &
489                 -MODULO(lon(1,1),360.)) > eps) &
490        .OR.(ABS( MODULO(x_last,360.) &
491                 -MODULO(lon(iilen ,jjlen),360.)) > eps ) ) THEN
492      CALL histerr (3,'flinopen', &
493        'file '//filename//' and the model do not', &
494        'share the same longitude coordinate', &
495        'Obtained by comparing the first and last values ')
496    ENDIF
497!---
498    CALL flinfindcood (fid_out, 'lat', vid, nbdim)
499    iret = NF90_GET_VAR (fid, vid, x_first, start=(/ iideb, jjdeb /))
500    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
501!---
502    IF (l_dbg) WRITE(ipslout,*) &
503      'from file lat first and last ',x_first,x_last
504    IF (l_dbg) WRITE(ipslout,*) &
505      'from model lat first and last ',lat(1,1),lat(iilen,jjlen)
506!---
507    IF (    (ABS(x_first-lat(1,1)) > eps) &
508        .OR.(ABS(x_last-lat(iilen,jjlen)) > eps) ) THEN
509      CALL histerr (3,'flinopen', &
510        'file '//filename//' and the model do not', &
511        'share the same latitude coordinate', &
512        'Obtained by comparing the first and last values ')
513    ENDIF
514!---
515    IF (llm > 0) THEN
516      CALL flinfindcood (fid_out, 'lev', vid, nbdim)
517      iret = NF90_GET_VAR (fid, vid, x_first, start=(/ 1 /))
518      iret = NF90_GET_VAR (fid, vid, x_last, start=(/ llm /))
519!-----
520      IF (l_dbg) WRITE(ipslout,*) &
521        'from file lev first and last ',x_first ,x_last
522      IF (l_dbg) WRITE(ipslout,*) &
523        'from model lev first and last ',lev(1),lev(llm)
524!-----
525      IF (    (ABS(x_first-lev(1)) > eps) &
526          .OR.(ABS(x_last-lev(llm)) > eps) ) THEN
527        CALL histerr (3,'flinopen', &
528          'file '//filename//' and the model do not', &
529          'share the same vertical coordinate', &
530          'Obtained by comparing the first and last values')
531      ENDIF
532    ENDIF
533!---
534  ELSE
535!---
536!-- 4.0 extracting the coordinates if we do not check
537!---
538    IF (l_dbg) WRITE(ipslout,*) 'flinopen 4.0 extracting the coordinates'
539!---
540    CALL flinfindcood (fid_out, 'lon', vid, nbdim)
541    IF (nbdim == 2) THEN
542      iret = NF90_GET_VAR (fid, vid, lon, &
543               start=(/ iideb, jjdeb /), count=(/ iilen, jjlen /))
544    ELSE
545      ALLOCATE(vec_tmp(iilen))
546      iret = NF90_GET_VAR (fid, vid, vec_tmp, &
547               start=(/ iideb /), count=(/ iilen /))
548      DO i=1,jjlen
549        lon(:,i) = vec_tmp(:)
550      ENDDO
551      DEALLOCATE(vec_tmp)
552    ENDIF
553!---
554    CALL flinfindcood (fid_out, 'lat', vid, nbdim)
555    IF (nbdim == 2) THEN
556      iret = NF90_GET_VAR (fid, vid, lat, &
557               start=(/ iideb, jjdeb /), count=(/ iilen, jjlen /))
558    ELSE
559      ALLOCATE(vec_tmp(jjlen))
560      iret = NF90_GET_VAR (fid, vid, vec_tmp, &
561               start=(/ jjdeb /), count=(/ jjlen /))
562      DO i=1,iilen
563        lat(i,:) = vec_tmp(:)
564      ENDDO
565      DEALLOCATE(vec_tmp)
566    ENDIF
567!---
568    IF (llm > 0) THEN
569      CALL flinfindcood (fid_out, 'lev', vid, nbdim)
570      IF (nbdim == 1) THEN
571        iret = NF90_GET_VAR (fid, vid, lev, &
572                 start=(/ 1 /), count=(/ llm /))
573      ELSE
574        CALL histerr (3,'flinopen', &
575          'Can not handle vertical coordinates that have more',&
576          'than 1 dimension',' ')
577      ENDIF
578    ENDIF
579  ENDIF
580!-
581! 5.0 Get all the details for the time if possible needed
582!-
583  IF (l_dbg) WRITE(ipslout,*) 'flinopen 5.0 Get time'
584!-
585  IF (ttm > 0) THEN
586!---
587!-- 5.1 Find the time axis. Prefered method is the 'timestep since'
588!---
589    gdtmaf_id = -1
590    gdtt_id = -1
591    old_id = -1
592    DO iv=1,ncnbva(fid_out)
593      name=''
594      iret = NF90_INQUIRE_VARIABLE (fid, iv, name=name)
595      units=''
596      iret = NF90_GET_ATT (fid, iv, 'units', units)
597      IF (INDEX(units,'seconds since') > 0) gdtmaf_id = iv
598      IF (INDEX(units,'timesteps since') > 0) gdtt_id = iv
599      IF (INDEX(name, 'tstep') > 0 .OR. INDEX(name,'time') > 0 ) old_id = iv
600    ENDDO
601!---
602    IF (gdtt_id > 0) THEN
603      vid = gdtt_id
604    ELSE IF (gdtmaf_id > 0) THEN
605      vid = gdtmaf_id
606    ELSE IF (old_id > 0) THEN
607      vid = old_id
608    ELSE
609      CALL histerr (3, 'flinopen', 'No time axis found',' ',' ')
610    ENDIF
611!---
612    ALLOCATE(vec_tmp(ttm))
613    iret = NF90_GET_VAR (fid,vid,vec_tmp,start=(/ 1 /),count=(/ ttm /))
614    itaus(1:ttm) = NINT(vec_tmp(1:ttm))
615    DEALLOCATE(vec_tmp)
616!---
617    IF (l_dbg) WRITE(ipslout,*) 'flinopen 5.1 Times ',itaus
618!---
619!-- Getting all the details for the time axis
620!---
621!-- Find the calendar
622    calendar = ''
623    iret = NF90_GET_ATT (fid,gdtmaf_id,'calendar',calendar)
624    IF (iret == NF90_NOERR) THEN
625      CALL ioconf_calendar(calendar)
626    ENDIF
627!--
628    units = ''
629    iret = NF90_GET_ATT (fid,vid,'units',units)
630    IF (gdtt_id > 0) THEN
631      units = units(INDEX(units,'since')+6:LEN_TRIM(units))
632      READ (units,'(I4.4,5(a,I2.2))') &
633        year0, strc, month0, strc, day0, &
634               strc, hours0, strc, minutes0, strc, seci
635      sec0 = hours0*3600. + minutes0*60. + seci
636      CALL ymds2ju (year0, month0, day0, sec0, date0)
637      IF (l_dbg) &
638        WRITE(ipslout,*) 'flinopen 5.1 gdtt_id year0 ... date0 ', &
639                   year0, month0, day0, sec0, date0
640!-----
641      iret = NF90_GET_ATT (fid, gdtt_id, 'tstep_sec', dt)
642    ELSE IF (gdtmaf_id > 0) THEN
643      units = units(INDEX(units,'since')+6:LEN_TRIM(units))
644      READ (units,'(I4.4,5(a,I2.2))') &
645        year0, strc, month0, strc, day0, &
646               strc, hours0, strc, minutes0, strc, seci
647      sec0 = hours0*3600. + minutes0*60. + seci
648      CALL ymds2ju (year0, month0, day0, sec0, date0)
649!-----
650      IF (l_dbg) &
651        WRITE(ipslout,*) 'flinopen 5.1 gdtmaf_id year0 ... date0 ', &
652                   year0, month0, day0, sec0, date0
653    ELSE IF (old_id > 0) THEN
654      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', dt)
655      nberr = 0 
656      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'day0', r_day)
657      IF (iret /= NF90_NOERR) nberr=nberr+1
658      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'sec0', sec)
659      IF (iret /= NF90_NOERR) nberr=nberr+1 
660      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'year0', r_year)
661      IF (iret /= NF90_NOERR) nberr=nberr+1
662      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'month0', r_month)
663      IF (iret /= NF90_NOERR) nberr=nberr+1
664
665      IF (nberr == 0) THEN
666         day = INT(r_day)
667         month = INT(r_month)
668         year = INT(r_year)
669
670         CALL ymds2ju (year, month, day, sec, date0)
671      ELSE
672          WRITE(*,*) 'Subroutine : flinopen_work ; time axis missing or not recognized in file', filename
673      ENDIF
674
675    ENDIF
676  ENDIF
677!-
678  IF (l_dbg) WRITE(ipslout,*) 'flinopen 6.0 File opened', date0, dt
679!---------------------------
680END SUBROUTINE flinopen_work
681!-
682!===
683!-
684SUBROUTINE flininfo (filename, iim, jjm, llm, ttm, fid_out)
685!---------------------------------------------------------------------
686!- This subroutine allows to get some information.
687!- It is usualy done within flinopen but the user may want to call
688!- it before in order to allocate the space needed to extract the
689!- data from the file.
690!---------------------------------------------------------------------
691  IMPLICIT NONE
692!-
693! ARGUMENTS
694!-
695  CHARACTER(LEN=*) :: filename
696  INTEGER :: iim, jjm, llm, ttm, fid_out
697!-
698! LOCAL
699!-
700  INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim
701  INTEGER :: iv, lll
702  INTEGER :: xid, yid, zid, tid
703  CHARACTER(LEN=:), ALLOCATABLE :: name
704  CHARACTER(LEN=30) :: axname
705!-
706  LOGICAL :: l_dbg
707!---------------------------------------------------------------------
708  CALL ipsldbg (old_status=l_dbg)
709
710  lll = LEN_TRIM(filename)
711  IF (filename(lll-2:lll) /= '.nc') THEN
712    name = filename(1:lll)//'.nc'
713  ELSE
714    name = filename(1:lll)
715  ENDIF
716!-
717  iret = NF90_OPEN (name, NF90_NOWRITE, fid)
718  IF (iret /= NF90_NOERR) THEN
719    CALL histerr(3, 'flininfo','Could not open file :',TRIM(name),' ')
720  ENDIF
721!-
722  iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &
723                      nAttributes=nb_atts, unlimitedDimId=id_unlim)
724!-
725  xid = -1; iim = 0;
726  yid = -1; jjm = 0;
727  zid = -1; llm = 0;
728  tid = -1; ttm = 0;
729!-
730  DO iv=1,ndims
731!---
732    iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)
733    CALL strlowercase (axname)
734    axname = ADJUSTL(axname)
735!---
736    IF (l_dbg) WRITE(ipslout,*) &
737      'flininfo - getting axname',iv,axname,lll
738!---
739    IF      (    (INDEX(axname,'x') == 1) &
740             .OR.(INDEX(axname,'lon') == 1) ) THEN
741      xid = iv; iim = lll;
742    ELSE IF (    (INDEX(axname,'y') == 1) &
743             .OR.(INDEX(axname,'lat') == 1) ) THEN
744      yid = iv; jjm = lll;
745    ELSE IF (    (INDEX(axname,'lev') == 1) &
746             .OR.(INDEX(axname,'plev') == 1) &
747             .OR.(INDEX(axname,'z') == 1) &
748             .OR.(INDEX(axname,'depth') == 1) ) THEN
749      zid = iv; llm = lll;
750    ELSE IF (    (INDEX(axname,'tstep') == 1) &
751             .OR.(INDEX(axname,'time') == 1) &
752             .OR.(INDEX(axname,'time_counter') == 1) ) THEN
753!---- For the time we certainly need to allow for other names
754      tid = iv; ttm = lll;
755    ELSE IF (ndims == 1) THEN
756!---- Nothing was found and ndims=1 then we have a vector of data
757      xid = 1; iim = lll;
758    ENDIF
759!---
760  ENDDO
761!-
762! Keep all this information
763!-
764  nbfiles = nbfiles+1
765!-
766  IF (nbfiles > nbfile_max) THEN
767    CALL histerr (3,'flininfo', &
768      'Too many files. Please increase nbfil_max', &
769      'in program flincom.F90.',' ')
770  ENDIF
771!-
772  ncids(nbfiles) = fid
773  ncnbd(nbfiles) = ndims
774!-
775  ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)
776!-
777  ncfunli(nbfiles) = id_unlim
778  ncnba(nbfiles)   = nb_atts
779  ncnbva(nbfiles)  = nvars
780  ncfileopen(nbfiles) = .TRUE.
781!-
782  fid_out = nbfiles
783!----------------------
784END SUBROUTINE flininfo
785!-
786!===
787!-
788SUBROUTINE flinput_r1d &
789  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
790!---------------------------------------------------------------------
791  IMPLICIT NONE
792!-
793  INTEGER :: fid_in
794  CHARACTER(LEN=*) :: varname
795  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
796  REAL :: var(:)
797!-
798  INTEGER :: fid, ncvarid, ndim, iret
799  LOGICAL :: l_dbg
800!---------------------------------------------------------------------
801  CALL ipsldbg (old_status=l_dbg)
802
803  IF (l_dbg) WRITE(ipslout,*) &
804     "flinput_r1d : SIZE(var) = ",SIZE(var)
805!-
806  CALL flinput_mat &
807    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
808     fid,ncvarid,ndim)
809!-
810  iret = NF90_PUT_VAR (fid, ncvarid, var, &
811           start=w_sta(1:ndim), count=w_len(1:ndim))
812!-------------------------
813END SUBROUTINE flinput_r1d
814!-
815!===
816!-
817SUBROUTINE flinput_r2d &
818  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
819!---------------------------------------------------------------------
820  IMPLICIT NONE
821!-
822  INTEGER :: fid_in
823  CHARACTER(LEN=*) :: varname
824  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
825  REAL :: var(:,:)
826!-
827  INTEGER :: fid, ncvarid, ndim, iret
828  LOGICAL :: l_dbg
829!---------------------------------------------------------------------
830  CALL ipsldbg (old_status=l_dbg)
831
832  IF (l_dbg) WRITE(ipslout,*) &
833     "flinput_r2d : SIZE(var) = ",SIZE(var)
834!-
835  CALL flinput_mat &
836    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
837     fid,ncvarid,ndim)
838!-
839  iret = NF90_PUT_VAR (fid, ncvarid, var, &
840           start=w_sta(1:ndim), count=w_len(1:ndim))
841!-------------------------
842END SUBROUTINE flinput_r2d
843!-
844!===
845!-
846SUBROUTINE flinput_r3d &
847  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
848!---------------------------------------------------------------------
849  IMPLICIT NONE
850!-
851  INTEGER :: fid_in
852  CHARACTER(LEN=*) :: varname
853  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
854  REAL :: var(:,:,:)
855!-
856  INTEGER :: fid, ncvarid, ndim, iret
857  LOGICAL :: l_dbg
858!---------------------------------------------------------------------
859  CALL ipsldbg (old_status=l_dbg)
860
861  IF (l_dbg) WRITE(ipslout,*) &
862     "flinput_r3d : SIZE(var) = ",SIZE(var)
863!-
864  CALL flinput_mat &
865    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
866     fid,ncvarid,ndim)
867!-
868  iret = NF90_PUT_VAR (fid, ncvarid, var, &
869           start=w_sta(1:ndim), count=w_len(1:ndim))
870!-------------------------
871END SUBROUTINE flinput_r3d
872!-
873!===
874!-
875SUBROUTINE flinput_r4d &
876  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
877!---------------------------------------------------------------------
878  IMPLICIT NONE
879!-
880  INTEGER :: fid_in
881  CHARACTER(LEN=*) :: varname
882  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
883  REAL :: var(:,:,:,:)
884!-
885  INTEGER :: fid, ncvarid, ndim, iret
886  LOGICAL :: l_dbg
887!---------------------------------------------------------------------
888  CALL ipsldbg (old_status=l_dbg)
889
890  IF (l_dbg) WRITE(ipslout,*) &
891     "flinput_r4d : SIZE(var) = ",SIZE(var)
892!-
893  CALL flinput_mat &
894    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
895     fid,ncvarid,ndim)
896!-
897  iret = NF90_PUT_VAR (fid, ncvarid, var, &
898           start=w_sta(1:ndim), count=w_len(1:ndim))
899!-------------------------
900END SUBROUTINE flinput_r4d
901!-
902!===
903!-
904SUBROUTINE flinput_mat &
905  (fid_in,varname,iim,nlonid,jjm,nlatid, &
906                  llm,zdimid,ttm,tdimid,fid,ncvarid,ndim)
907!---------------------------------------------------------------------
908  IMPLICIT NONE
909!-
910  INTEGER :: fid_in
911  CHARACTER(LEN=*) :: varname
912  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
913  INTEGER :: fid, ncvarid, ndim
914!-
915! LOCAL
916!-
917  INTEGER :: iret
918!---------------------------------------------------------------------
919  fid = ncids(fid_in)
920!-
921  w_sta(1:4) = (/      1,      1,  1,  1 /)
922  w_len(1:2) = (/    iim,    jjm /)
923  w_dim(1:2) = (/ nlonid, nlatid /)
924!-
925  IF ( (llm > 0).AND.(ttm > 0) ) THEN
926    ndim = 4
927    w_len(3:4) = (/    llm,    ttm /)
928    w_dim(3:4) = (/ zdimid, tdimid /)
929  ELSE IF (llm > 0) THEN
930    ndim = 3
931    w_dim(3) = zdimid
932    w_len(3) = llm
933  ELSE IF (ttm > 0) THEN
934    ndim = 3
935    w_dim(3) = tdimid
936    w_len(3) = ttm
937  ELSE
938    ndim = 2
939  ENDIF
940!-
941  iret = NF90_REDEF   (fid)
942  iret = NF90_DEF_VAR (fid,varname,NF90_FLOAT,w_dim(1:ndim),ncvarid)
943  iret = NF90_PUT_ATT (fid,ncvarid,'short_name',TRIM(varname))
944  iret = NF90_ENDDEF  (fid)
945!--------------------------
946END  SUBROUTINE flinput_mat
947!-
948!===
949!-
950SUBROUTINE flinput_scal &
951  (fid_in, varname, iim, nlonid, jjm, nlatid, &
952                    llm, zdimid, ttm, tdimid, var)
953!---------------------------------------------------------------------
954  IMPLICIT NONE
955!-
956  INTEGER :: fid_in
957  CHARACTER(LEN=*) :: varname
958  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
959  REAL :: var
960!-
961! LOCAL
962!-
963  INTEGER :: fid, iret
964!---------------------------------------------------------------------
965  fid = ncids(fid_in)
966!-
967  iret = NF90_REDEF   (fid)
968  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, varname, REAL(var,KIND=4))
969  iret = NF90_ENDDEF  (fid)
970!---------------------------
971END  SUBROUTINE flinput_scal
972!-
973!===
974!-
975SUBROUTINE flinget_r1d &
976  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
977!---------------------------------------------------------------------
978  IMPLICIT NONE
979!-
980  INTEGER :: fid_in
981  CHARACTER(LEN=*) :: varname
982  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
983  REAL :: var(:)
984!-
985  INTEGER :: jl, ji
986  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
987  LOGICAL :: l_dbg
988!---------------------------------------------------------------------
989  CALL ipsldbg (old_status=l_dbg)
990
991  IF (.NOT.ALLOCATED(buff_tmp)) THEN
992    IF (l_dbg) WRITE(ipslout,*) &
993      "flinget_r1d : allocate buff_tmp for buff_sz = ",SIZE(var)
994    ALLOCATE (buff_tmp(SIZE(var)))
995  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
996    IF (l_dbg) WRITE(ipslout,*) &
997      "flinget_r1d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
998    DEALLOCATE (buff_tmp)
999    ALLOCATE (buff_tmp(SIZE(var)))
1000  ENDIF
1001!-
1002  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
1003                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
1004!-
1005  jl=0
1006  DO ji=1,SIZE(var,1)
1007    jl=jl+1
1008    var(ji) = buff_tmp(jl)
1009  ENDDO
1010!-------------------------
1011  IF (ALLOCATED(buff_tmp)) DEALLOCATE(buff_tmp)
1012END SUBROUTINE flinget_r1d
1013!-
1014!===
1015!-
1016SUBROUTINE flinget_r2d &
1017  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
1018!---------------------------------------------------------------------
1019  IMPLICIT NONE
1020!-
1021  INTEGER :: fid_in
1022  CHARACTER(LEN=*) :: varname
1023  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
1024  REAL :: var(:,:)
1025!-
1026  INTEGER :: jl, jj, ji
1027  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
1028  LOGICAL :: l_dbg
1029!---------------------------------------------------------------------
1030  CALL ipsldbg (old_status=l_dbg)
1031
1032  IF (.NOT.ALLOCATED(buff_tmp)) THEN
1033    IF (l_dbg) WRITE(ipslout,*) &
1034      "flinget_r2d : allocate buff_tmp for buff_sz = ",SIZE(var)
1035    ALLOCATE (buff_tmp(SIZE(var)))
1036  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
1037    IF (l_dbg) WRITE(ipslout,*) &
1038      "flinget_r2d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
1039    DEALLOCATE (buff_tmp)
1040    ALLOCATE (buff_tmp(SIZE(var)))
1041  ENDIF
1042!-
1043  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
1044                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
1045!-
1046  jl=0
1047  DO jj=1,SIZE(var,2)
1048    DO ji=1,SIZE(var,1)
1049      jl=jl+1
1050      var(ji,jj) = buff_tmp(jl)
1051    ENDDO
1052  ENDDO
1053!-------------------------
1054  IF (ALLOCATED(buff_tmp)) DEALLOCATE(buff_tmp)
1055END SUBROUTINE flinget_r2d
1056!-
1057!===
1058!-
1059SUBROUTINE flinget_r2d_zoom2d &
1060  (fid_in,varname,iim,jjm,llm,ttm, &
1061   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
1062!---------------------------------------------------------------------
1063  IMPLICIT NONE
1064!-
1065  INTEGER :: fid_in
1066  CHARACTER(LEN=*) :: varname
1067  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
1068  REAL :: var(:,:)
1069!-
1070  INTEGER :: jl, jj, ji
1071  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
1072  LOGICAL :: l_dbg
1073!---------------------------------------------------------------------
1074  CALL ipsldbg (old_status=l_dbg)
1075
1076  IF (.NOT.ALLOCATED(buff_tmp)) THEN
1077    IF (l_dbg) WRITE(ipslout,*) &
1078      "flinget_r2d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
1079    ALLOCATE (buff_tmp(SIZE(var)))
1080  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
1081    IF (l_dbg) WRITE(ipslout,*) &
1082      "flinget_r2d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
1083    DEALLOCATE (buff_tmp)
1084    ALLOCATE (buff_tmp(SIZE(var)))
1085  ENDIF
1086!-
1087  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
1088                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
1089!-
1090  jl=0
1091  DO jj=1,SIZE(var,2)
1092    DO ji=1,SIZE(var,1)
1093      jl=jl+1
1094      var(ji,jj) = buff_tmp(jl)
1095    ENDDO
1096  ENDDO
1097  IF (ALLOCATED(buff_tmp)) DEALLOCATE(buff_tmp)
1098!--------------------------------
1099END SUBROUTINE flinget_r2d_zoom2d
1100!-
1101!===
1102!-
1103SUBROUTINE flinget_r3d &
1104  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
1105!---------------------------------------------------------------------
1106  IMPLICIT NONE
1107!-
1108  INTEGER :: fid_in
1109  CHARACTER(LEN=*) :: varname
1110  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
1111  REAL :: var(:,:,:)
1112!-
1113  INTEGER :: jl, jk, jj, ji
1114  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
1115  LOGICAL :: l_dbg
1116!---------------------------------------------------------------------
1117  CALL ipsldbg (old_status=l_dbg)
1118
1119  IF (.NOT.ALLOCATED(buff_tmp)) THEN
1120    IF (l_dbg) WRITE(ipslout,*) &
1121      "flinget_r3d : allocate buff_tmp for buff_sz = ",SIZE(var)
1122    ALLOCATE (buff_tmp(SIZE(var)))
1123  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
1124    IF (l_dbg) WRITE(ipslout,*) &
1125      "flinget_r3d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
1126    DEALLOCATE (buff_tmp)
1127    ALLOCATE (buff_tmp(SIZE(var)))
1128  ENDIF
1129!-
1130  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
1131                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
1132!-
1133  jl=0
1134  DO jk=1,SIZE(var,3)
1135    DO jj=1,SIZE(var,2)
1136      DO ji=1,SIZE(var,1)
1137        jl=jl+1
1138        var(ji,jj,jk) = buff_tmp(jl)
1139      ENDDO
1140    ENDDO
1141  ENDDO
1142!-------------------------
1143  IF (ALLOCATED(buff_tmp)) DEALLOCATE(buff_tmp)
1144END SUBROUTINE flinget_r3d
1145!-
1146!===
1147!-
1148SUBROUTINE flinget_r3d_zoom2d &
1149  (fid_in,varname,iim,jjm,llm,ttm, &
1150   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
1151!---------------------------------------------------------------------
1152  IMPLICIT NONE
1153!-
1154  INTEGER :: fid_in
1155  CHARACTER(LEN=*) :: varname
1156  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
1157  REAL :: var(:,:,:)
1158!-
1159  INTEGER :: jl, jk, jj, ji
1160  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
1161  LOGICAL :: l_dbg
1162!---------------------------------------------------------------------
1163  CALL ipsldbg (old_status=l_dbg)
1164
1165  IF (.NOT.ALLOCATED(buff_tmp)) THEN
1166    IF (l_dbg) WRITE(ipslout,*) &
1167      "flinget_r3d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
1168    ALLOCATE (buff_tmp(SIZE(var)))
1169  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
1170    IF (l_dbg) WRITE(ipslout,*) &
1171      "flinget_r3d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
1172    DEALLOCATE (buff_tmp)
1173    ALLOCATE (buff_tmp(SIZE(var)))
1174  ENDIF
1175!-
1176  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
1177                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
1178!-
1179  jl=0
1180  DO jk=1,SIZE(var,3)
1181    DO jj=1,SIZE(var,2)
1182      DO ji=1,SIZE(var,1)
1183        jl=jl+1
1184        var(ji,jj,jk) = buff_tmp(jl)
1185      ENDDO
1186    ENDDO
1187  ENDDO
1188!--------------------------------
1189  IF (ALLOCATED(buff_tmp)) DEALLOCATE(buff_tmp)
1190END SUBROUTINE flinget_r3d_zoom2d
1191!-
1192!===
1193!-
1194SUBROUTINE flinget_r4d &
1195  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
1196!---------------------------------------------------------------------
1197  IMPLICIT NONE
1198!-
1199  INTEGER :: fid_in
1200  CHARACTER(LEN=*) :: varname
1201  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
1202  REAL :: var(:,:,:,:)
1203!-
1204  INTEGER :: jl, jk, jj, ji, jm
1205  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
1206  LOGICAL :: l_dbg
1207!---------------------------------------------------------------------
1208  CALL ipsldbg (old_status=l_dbg)
1209
1210  IF (.NOT.ALLOCATED(buff_tmp)) THEN
1211    IF (l_dbg) WRITE(ipslout,*) &
1212      "flinget_r4d : allocate buff_tmp for buff_sz = ",SIZE(var)
1213    ALLOCATE (buff_tmp(SIZE(var)))
1214  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
1215    IF (l_dbg) WRITE(ipslout,*) &
1216      "flinget_r4d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
1217    DEALLOCATE (buff_tmp)
1218    ALLOCATE (buff_tmp(SIZE(var)))
1219  ENDIF
1220!-
1221  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
1222                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
1223!-
1224  jl=0
1225  DO jm=1,SIZE(var,4)
1226    DO jk=1,SIZE(var,3)
1227      DO jj=1,SIZE(var,2)
1228        DO ji=1,SIZE(var,1)
1229          jl=jl+1
1230          var(ji,jj,jk,jm) = buff_tmp(jl)
1231        ENDDO
1232      ENDDO
1233    ENDDO
1234  ENDDO
1235!-------------------------
1236  IF (ALLOCATED(buff_tmp)) DEALLOCATE(buff_tmp)
1237END SUBROUTINE flinget_r4d
1238!-
1239!===
1240!-
1241SUBROUTINE flinget_r4d_zoom2d &
1242  (fid_in,varname,iim,jjm,llm,ttm, &
1243   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
1244!---------------------------------------------------------------------
1245  IMPLICIT NONE
1246!-
1247  INTEGER :: fid_in
1248  CHARACTER(LEN=*) :: varname
1249  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
1250  REAL :: var(:,:,:,:)
1251!-
1252  INTEGER :: jl, jk, jj, ji, jm
1253  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
1254  LOGICAL :: l_dbg
1255!---------------------------------------------------------------------
1256  CALL ipsldbg (old_status=l_dbg)
1257
1258  IF (.NOT.ALLOCATED(buff_tmp)) THEN
1259    IF (l_dbg) WRITE(ipslout,*) &
1260      "flinget_r4d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
1261    ALLOCATE (buff_tmp(SIZE(var)))
1262  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
1263    IF (l_dbg) WRITE(ipslout,*) &
1264      "flinget_r4d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
1265    DEALLOCATE (buff_tmp)
1266    ALLOCATE (buff_tmp(SIZE(var)))
1267  ENDIF
1268!-
1269  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
1270                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
1271!-
1272  jl=0
1273  DO jm=1,SIZE(var,4)
1274    DO jk=1,SIZE(var,3)
1275      DO jj=1,SIZE(var,2)
1276        DO ji=1,SIZE(var,1)
1277          jl=jl+1
1278          var(ji,jj,jk,jm) = buff_tmp(jl)
1279        ENDDO
1280      ENDDO
1281    ENDDO
1282  ENDDO
1283!--------------------------------
1284  IF (ALLOCATED(buff_tmp)) DEALLOCATE(buff_tmp)
1285END SUBROUTINE flinget_r4d_zoom2d
1286!-
1287!===
1288!-
1289SUBROUTINE flinget_mat &
1290  (fid_in, varname, iim, jjm, llm, ttm, itau_dep, &
1291   itau_fin, iideb, iilen, jjdeb, jjlen, var)
1292!---------------------------------------------------------------------
1293!- This subroutine will read the variable named varname from
1294!- the file previously opened by flinopen and identified by fid
1295!-
1296!- It is checked that the dimensions of the variable to be read
1297!- correspond to what the user requested when he specified
1298!- iim, jjm and llm. The only exception which is allowed is
1299!- for compressed data where the horizontal grid is not expected
1300!- to be iim x jjm.
1301!-
1302!- If variable is of size zero a global attribute is read.
1303!- This global attribute will be of type real
1304!-
1305!- INPUT
1306!-
1307!- fid      : File ID returned by flinopen
1308!- varname  : Name of the variable to be read from the file
1309!- iim      : | These three variables give the size of the variables
1310!- jjm      : | to be read. It will be verified that the variables
1311!- llm      : | fits in there.
1312!- ttm      : |
1313!- itau_dep : Time step at which we will start to read
1314!- itau_fin : Time step until which we are going to read
1315!-            For the moment this is done on indexes
1316!-            but it should be in the physical space.
1317!-            If there is no time-axis in the file then use a
1318!-            itau_fin < itau_dep, this will tell flinget not to
1319!-            expect a time-axis in the file.
1320!- iideb    : index i for zoom
1321!- iilen    : length of zoom
1322!- jjdeb    : index j for zoom
1323!- jjlen    : length of zoom
1324!-
1325!- OUTPUT
1326!-
1327!- var      : array that will contain the data
1328!---------------------------------------------------------------------
1329  IMPLICIT NONE
1330!-
1331! ARGUMENTS
1332!-
1333  INTEGER, INTENT(IN) :: fid_in
1334  CHARACTER(LEN=*), INTENT(IN) :: varname
1335  INTEGER, INTENT(IN) :: iim, jjm, llm, ttm
1336  INTEGER, INTENT(IN) :: itau_dep, itau_fin, iideb, iilen, jjdeb, jjlen
1337  REAL, INTENT(OUT) :: var(:)
1338!-
1339! LOCAL
1340!-
1341  INTEGER :: iret, fid
1342  INTEGER :: vid, cvid, clen
1343  CHARACTER(LEN=70) :: str1
1344  CHARACTER(LEN=250) :: att_n, tmp_n
1345  CHARACTER(LEN=5) :: axs_l
1346  INTEGER :: tmp_i
1347  REAL,SAVE :: mis_v=0.
1348  REAL :: tmp_r
1349  INTEGER :: ndims, x_typ, nb_atts
1350  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dimids
1351  INTEGER :: i, nvars, i2d, cnd
1352  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: var_tmp
1353  INTEGER :: itau_len
1354  LOGICAL :: uncompress = .FALSE.
1355  INTEGER :: il, ip, i2p, it
1356  !-
1357  LOGICAL :: l_dbg
1358!---------------------------------------------------------------------
1359  CALL ipsldbg (old_status=l_dbg)
1360  !-
1361  fid = ncids(fid_in)
1362!-
1363  IF (l_dbg) THEN
1364    WRITE(ipslout,*) &
1365    'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname)
1366    WRITE(ipslout,*) &
1367    'flinget_mat : iim, jjm, llm, ttm, itau_dep, itau_fin :', &
1368    iim, jjm, llm, ttm, itau_dep, itau_fin
1369    WRITE(ipslout,*) &
1370    'flinget_mat : iideb, iilen, jjdeb, jjlen :', &
1371    iideb, iilen, jjdeb, jjlen
1372  ENDIF
1373!-
1374  uncompress = .FALSE.
1375!-
1376! 1.0 We get first all the details on this variable from the file
1377!-
1378  nvars = ncnbva(fid_in)
1379!-
1380  vid = -1
1381  iret = NF90_INQ_VARID (fid, varname, vid)
1382!-
1383  IF (vid < 0 .OR. iret /= NF90_NOERR) THEN
1384    CALL histerr (3,'flinget', &
1385      'Variable '//TRIM(varname)//' not found in file',' ',' ')
1386  ENDIF
1387!-
1388  iret = NF90_INQUIRE_VARIABLE (fid, vid, &
1389           ndims=ndims, dimids=dimids, nAtts=nb_atts)
1390  IF (l_dbg) THEN
1391    WRITE(ipslout,*) &
1392    'flinget_mat : fid, vid :', fid, vid
1393    WRITE(ipslout,*) &
1394    'flinget_mat : ndims, dimids(1:ndims), nb_atts :', &
1395    ndims, dimids(1:ndims), nb_atts
1396  ENDIF
1397!-
1398  w_dim(:) = 0
1399  DO i=1,ndims
1400    iret  = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i))
1401  ENDDO
1402  IF (l_dbg) WRITE(ipslout,*) &
1403    'flinget_mat : w_dim :', w_dim(1:ndims)
1404!-
1405  mis_v = 0.0; axs_l = ' ';
1406!-
1407  IF (nb_atts > 0) THEN
1408     IF (l_dbg) THEN
1409      WRITE(ipslout,*) 'flinget_mat : attributes for variable :'
1410    ENDIF
1411  ENDIF
1412  DO i=1,nb_atts
1413    iret = NF90_INQ_ATTNAME (fid, vid, i, att_n)
1414    iret = NF90_INQUIRE_ATTRIBUTE (fid, vid, att_n, xtype=x_typ)
1415    CALL strlowercase (att_n)
1416    IF      (    (x_typ == NF90_INT).OR.(x_typ == NF90_SHORT) &
1417             .OR.(x_typ == NF90_BYTE) ) THEN
1418      iret = NF90_GET_ATT (fid, vid, att_n, tmp_i)
1419        IF (l_dbg) THEN
1420        WRITE(ipslout,*) '   ',TRIM(att_n),' : ',tmp_i
1421      ENDIF
1422    ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN
1423      iret = NF90_GET_ATT (fid, vid, att_n, tmp_r)
1424        IF (l_dbg) THEN
1425        WRITE(ipslout,*) '   ',TRIM(att_n),' : ',tmp_r
1426      ENDIF
1427      IF (index(att_n,'missing_value') > 0) THEN
1428        mis_v = tmp_r
1429      ENDIF
1430    ELSE
1431      tmp_n = ''
1432      iret = NF90_GET_ATT (fid, vid, att_n, tmp_n)
1433        IF (l_dbg) THEN
1434        WRITE(ipslout,*) '   ',TRIM(att_n),' : ',TRIM(tmp_n)
1435      ENDIF
1436      IF (index(att_n,'axis') > 0) THEN
1437        axs_l = tmp_n
1438      ENDIF
1439    ENDIF
1440  ENDDO
1441!?
1442!!!!!!!!!! We will need a verification on the type of the variable
1443!?
1444!-
1445! 2.0 The dimensions are analysed to determine what is to be read
1446!-
1447! 2.1 the longitudes
1448!-
1449  IF ( w_dim(1) /= iim .OR. w_dim(2) /= jjm) THEN
1450!---
1451!-- There is a possibility that we have to deal with a compressed axis !
1452!---
1453    iret = NF90_INQUIRE_DIMENSION (fid, dimids(1), &
1454             name=tmp_n, len=clen)
1455    iret = NF90_INQ_VARID (fid, tmp_n, cvid)
1456!---
1457    IF (l_dbg) WRITE(ipslout,*) &
1458      'Dimname, iret , NF90_NOERR : ',TRIM(tmp_n),iret,NF90_NOERR
1459!---
1460!-- If we have an axis which has the same name
1461!-- as the dimension we can see if it is compressed
1462!---
1463!-- TODO TODO for zoom2d
1464!---
1465    IF (iret == NF90_NOERR) THEN
1466      iret = NF90_GET_ATT (fid, cvid, 'compress', str1)
1467!-----
1468      IF (iret == NF90_NOERR) THEN
1469        iret = NF90_INQUIRE_VARIABLE (fid,cvid,xtype=x_typ,ndims=cnd)
1470!-------
1471        IF ( cnd /= 1 .AND. x_typ /= NF90_INT) THEN
1472          CALL histerr (3,'flinget', &
1473            'Variable '//TRIM(tmp_n)//' can not be a compressed axis', &
1474            'Either it has too many dimensions'// &
1475            ' or it is not of type integer', ' ')
1476        ELSE
1477!---------
1478!-------- Let us see if we already have that index table
1479!---------
1480          IF (    (cind_len /= clen).OR.(cind_vid /= cvid) &
1481              .OR.(cind_fid /= fid) ) THEN
1482            IF (ALLOCATED(cindex))   DEALLOCATE(cindex)
1483            ALLOCATE(cindex(clen))
1484            cind_len = clen
1485            cind_vid = cvid
1486            cind_fid = fid
1487            iret = NF90_GET_VAR (fid, cvid, cindex)
1488          ENDIF
1489!---------
1490!-------- In any case we need to set the slab of data to be read
1491!---------
1492          uncompress = .TRUE.
1493          w_sta(1) = 1
1494          w_len(1) = clen
1495          i2d = 1
1496        ENDIF
1497      ELSE
1498        str1 = 'The horizontal dimensions of '//varname
1499        CALL histerr (3,'flinget',str1, &
1500          'is not compressed and does not'// &
1501          ' correspond to the requested size',' ')
1502      ENDIF
1503    ELSE
1504      IF (w_dim(1) /= iim) THEN
1505        str1 = 'The longitude dimension of '//varname
1506        CALL histerr (3,'flinget',str1, &
1507          'in the file is not equal to the dimension', &
1508          'that should be read')
1509      ENDIF
1510      IF (w_dim(2) /= jjm) THEN
1511        str1 = 'The latitude dimension of '//varname
1512        CALL histerr (3,'flinget',str1, &
1513          'in the file is not equal to the dimension', &
1514          'that should be read')
1515      ENDIF
1516    ENDIF
1517  ELSE
1518    w_sta(1:2) = (/ iideb, jjdeb /)
1519    w_len(1:2) = (/ iilen, jjlen /)
1520    i2d = 2
1521  ENDIF
1522!-
1523! 2.3 Now the difficult part, the 3rd dimension which can be
1524! time or levels.
1525!-
1526! Priority is given to the time axis if only three axes are present.
1527!-
1528  IF (ndims > i2d) THEN
1529!---
1530!-- 2.3.1 We have a vertical axis
1531!---
1532    IF (llm == 1 .AND. ndims == i2d+2 .OR. llm == w_dim(i2d+1)) THEN
1533!-----
1534      IF (w_dim(i2d+1) /= llm) THEN
1535        CALL histerr (3,'flinget', &
1536          'The vertical dimension of '//varname, &
1537          'in the file is not equal to the dimension', &
1538          'that should be read')
1539      ELSE
1540        w_sta(i2d+1) = 1
1541        IF (llm > 0) THEN
1542          w_len(i2d+1) = llm
1543        ELSE
1544          w_len(i2d+1) = w_sta(i2d+1)
1545        ENDIF
1546      ENDIF
1547!-----
1548      IF ((itau_fin-itau_dep) >= 0) THEN
1549        IF      (ndims /= i2d+2) THEN
1550          CALL histerr (3,'flinget', &
1551            'You attempt to read a time slab', &
1552            'but there is no time axis on this variable', varname)
1553        ELSE IF ((itau_fin - itau_dep) <= w_dim(i2d+2)) THEN
1554          w_sta(i2d+2) = itau_dep
1555          w_len(i2d+2) = itau_fin-itau_dep+1
1556        ELSE
1557          CALL histerr (3,'flinget', &
1558            'The time step you try to read is not', &
1559            'in the file (1)', varname)
1560        ENDIF
1561      ELSE IF (ndims == i2d+2 .AND. w_dim(i2d+2) > 1) THEN
1562        CALL histerr (3,'flinget', &
1563          'There is a time axis in the file but no', &
1564          'time step give in the call', varname)
1565      ELSE
1566        w_sta(i2d+2) = 1
1567        w_len(i2d+2) = 1
1568      ENDIF
1569    ELSE
1570!-----
1571!---- 2.3.2 We do not have any vertical axis
1572!-----
1573      IF (ndims == i2d+2) THEN
1574        CALL histerr (3,'flinget', &
1575          'The file contains 4 dimensions', &
1576          'but only 3 are requestes for variable ', varname)
1577      ENDIF
1578      IF ((itau_fin-itau_dep) >= 0) THEN
1579        IF (ndims == i2d+1) THEN
1580          IF ((itau_fin-itau_dep) < w_dim(i2d+1) ) THEN
1581            w_sta(i2d+1) = itau_dep
1582            w_len(i2d+1) = itau_fin-itau_dep+1
1583          ELSE
1584            CALL histerr (3,'flinget', &
1585              'The time step you try to read is not', &
1586              'in the file (2)', varname)
1587          ENDIF
1588        ELSE
1589          CALL histerr (3,'flinget', &
1590            'From your input you sould have 3 dimensions', &
1591            'in the file but there are 4', varname)
1592        ENDIF
1593      ELSE
1594        IF (ndims == i2d+1 .AND. w_dim(i2d+1) > 1) THEN
1595          CALL histerr (3,'flinget', &
1596            'There is a time axis in the file but no', &
1597            'time step given in the call', varname)
1598        ELSE
1599          w_sta(i2d+1) = 1
1600          w_len(i2d+1) = 1
1601        ENDIF
1602      ENDIF
1603    ENDIF
1604  ELSE
1605!---
1606!-- 2.3.3 We do not have any vertical axis
1607!---
1608    w_sta(i2d+1:i2d+2) = (/ 0, 0 /)
1609    w_len(i2d+1:i2d+2) = (/ 0, 0 /)
1610  ENDIF
1611!-
1612! 3.0 Reading the data
1613!-
1614  IF (l_dbg) WRITE(ipslout,*) &
1615    'flinget_mat 3.0 : ', uncompress, w_sta, w_len
1616!---
1617  var(:) = mis_v
1618  IF (uncompress) THEN
1619!---
1620    IF (ALLOCATED(var_tmp)) THEN
1621      IF (SIZE(var_tmp) < PRODUCT(w_len(:),mask=(w_len>1))) THEN
1622         DEALLOCATE(var_tmp)
1623         ALLOCATE(var_tmp(PRODUCT(w_len(:),mask=(w_len>1))))
1624      ENDIF
1625    ELSE
1626      ALLOCATE(var_tmp(PRODUCT(w_len(:),mask=(w_len>1))))
1627    ENDIF
1628!---
1629    iret = NF90_GET_VAR (fid, vid, var_tmp, &
1630             start=w_sta(:), count=w_len(:))
1631!---
1632    IF (iret /= NF90_NOERR) THEN
1633        WRITE(ipslout,*) 'flinget_mat 2.9 : ',NF90_STRERROR (iret)
1634        CALL ipslerr(3, 'flinget_mat','Error on netcdf NF90_GET_VAR','', '')
1635    ENDIF
1636!---
1637    itau_len=itau_fin-itau_dep+1
1638    IF (l_dbg) WRITE(ipslout,*) 'flinget_mat 3.0 : clen, itau_len ',clen,itau_len
1639    var(:) = mis_v
1640    IF (itau_len > 0) THEN
1641       DO it=1,itau_len
1642          DO il=1,clen
1643             ip = il + (it-1)*clen
1644             i2p = cindex(il)+(it-1)*iim*jjm
1645             var(i2p) = var_tmp(ip)
1646          ENDDO
1647       ENDDO
1648    ELSE
1649       var(cindex(:)) = var_tmp(:)
1650    ENDIF
1651!---
1652  ELSE
1653    iret = NF90_GET_VAR (fid, vid, var, &
1654             start=w_sta(:), count=w_len(:))
1655
1656    IF (iret /= NF90_NOERR) THEN
1657        WRITE(ipslout,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret)
1658        CALL  ipslerr(3, 'flinget_mat','Error on netcdf NF90_GET_VAR','Read in netcdf failed', '')
1659    ENDIF
1660  ENDIF
1661!-
1662  IF (l_dbg) WRITE(ipslout,*) 'flinget_mat 3.2 : ',NF90_STRERROR (iret)
1663!--------------------------
1664END  SUBROUTINE flinget_mat
1665!-
1666!===
1667!-
1668SUBROUTINE flinget_scal &
1669  (fid_in, varname, iim, jjm, llm, ttm, itau_dep, itau_fin, var)
1670!---------------------------------------------------------------------
1671!- This subroutine will read the variable named varname from
1672!- the file previously opened by flinopen and identified by fid
1673!-
1674!- If variable is of size zero a global attribute is read. This
1675!- global attribute will be of type real
1676!-
1677!- INPUT
1678!-
1679!- fid      : File ID returned by flinopen
1680!- varname  : Name of the variable to be read from the file
1681!- iim      : | These three variables give the size of the variables
1682!- jjm      : | to be read. It will be verified that the variables
1683!- llm      : | fits in there.
1684!- ttm      : |
1685!- itau_dep : Time step at which we will start to read
1686!- itau_fin : Time step until which we are going to read
1687!-           For the moment this is done on indeces but it should be
1688!-           in the physical space
1689!-           If there is no time-axis in the file then use a
1690!-           itau_fin < itau_dep, this will tell flinget not to
1691!-           expect a time-axis in the file.
1692!-
1693!- OUTPUT
1694!-
1695!- var      : scalar that will contain the data
1696!---------------------------------------------------------------------
1697  IMPLICIT NONE
1698!-
1699! ARGUMENTS
1700!-
1701  INTEGER :: fid_in
1702  CHARACTER(LEN=*) :: varname
1703  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
1704  REAL :: var
1705!-
1706! LOCAL
1707!-
1708  INTEGER :: iret, fid, vid
1709  INTEGER :: attlen, attnum
1710  INTEGER :: ndims, nb_atts
1711  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dimids
1712  LOGICAL :: var_exists
1713!-
1714  LOGICAL :: l_dbg
1715  INTEGER :: lll
1716!---------------------------------------------------------------------
1717  CALL ipsldbg (old_status=l_dbg)
1718
1719  IF (l_dbg) THEN
1720    WRITE (ipslout,*) 'flinget_scal in file with id ',fid_in
1721  ENDIF
1722!-
1723  fid = ncids(fid_in)
1724  iret = NF90_INQUIRE_ATTRIBUTE(fid, NF90_GLOBAL, varname, len=attlen, attnum=attnum)
1725!-
1726! 1.0 Reading a global attribute
1727!-
1728  IF ( iret == nf90_noerr ) THEN
1729     !
1730     ! This seems to be a Global attribute
1731     !
1732     iret = NF90_GET_ATT (fid, NF90_GLOBAL, varname, var)
1733  ELSE
1734     !
1735     ! If there was an error on the test for a global attribute it
1736     ! is perhaps a scalar variable.
1737     !
1738     vid = -1
1739     iret = NF90_INQ_VARID (fid, varname, vid)
1740     !
1741     IF ( (vid >= 0).AND.(iret == NF90_NOERR) ) THEN
1742        iret = NF90_INQUIRE_VARIABLE (fid, vid, &
1743             ndims=ndims, dimids=dimids, nAtts=nb_atts)
1744        IF (ndims == 1) THEN
1745           iret = NF90_INQUIRE_DIMENSION (fid, dimids(1), len=lll)
1746        ENDIF
1747
1748        IF ( ((ndims == 0) .OR. ((ndims == 1).AND.(lll == 1))) .AND. (nb_atts >= 0) ) THEN
1749           iret = NF90_GET_VAR(fid, vid, var)
1750        ELSE
1751           CALL histerr (3,'flinget_scal', &
1752                'The variable has coordinates and thus is probably not a scalar.', &
1753                'Check your netCDF file.', " ")
1754        ENDIF
1755     ENDIF
1756     IF (l_dbg) THEN
1757        WRITE(ipslout,*) "Reading a Scalar value for varibale ", varname," It has value ", var
1758     ENDIF
1759  ENDIF
1760!-
1761!---------------------------
1762END  SUBROUTINE flinget_scal
1763!-
1764!===
1765!-
1766SUBROUTINE flinfindcood (fid_in, axtype, vid, ndim)
1767!---------------------------------------------------------------------
1768!- This subroutine explores the file in order to find
1769!- the coordinate according to a number of rules
1770!---------------------------------------------------------------------
1771  IMPLICIT NONE
1772!-
1773! ARGUMENTS
1774!-
1775  INTEGER :: fid_in, vid, ndim
1776  CHARACTER(LEN=3) :: axtype
1777!-
1778! LOCAL
1779!-
1780  INTEGER :: iv, iret, dimnb
1781  CHARACTER(LEN=40) :: dimname, dimuni1, dimuni2, dimuni3
1782  CHARACTER(LEN=80) :: str1
1783  LOGICAL :: found_rule = .FALSE.
1784!---------------------------------------------------------------------
1785  vid = -1
1786!-
1787! Make sure all strings are invalid
1788!-
1789  dimname = '?-?'
1790  dimuni1 = '?-?'
1791  dimuni2 = '?-?'
1792  dimuni3 = '?-?'
1793!-
1794! First rule : we look for the correct units
1795! lon : east
1796! lat : north
1797! We make an exact check as it would be too easy to mistake
1798! some units by just comparing the substrings.
1799!-
1800  SELECTCASE(axtype)
1801  CASE ('lon')
1802    dimuni1 = 'degree_e'
1803    dimuni2 = 'degrees_e'
1804    found_rule = .TRUE.
1805  CASE('lat')
1806    dimuni1 = 'degree_n'
1807    dimuni2 = 'degrees_n'
1808    found_rule = .TRUE.
1809  CASE('lev')
1810    dimuni1 = 'm'
1811    dimuni2 = 'km'
1812    dimuni3 = 'hpa'
1813    found_rule = .TRUE.
1814  CASE DEFAULT
1815    found_rule = .FALSE.
1816  END SELECT
1817!-
1818  IF (found_rule) THEN
1819    iv = 0
1820    DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
1821      iv = iv+1
1822      str1 = ''
1823      iret = NF90_GET_ATT (ncids(fid_in), iv, 'units', str1)
1824      IF (iret == NF90_NOERR) THEN
1825        CALL strlowercase (str1)
1826        IF (    (INDEX(str1, TRIM(dimuni1)) == 1) &
1827            .OR.(INDEX(str1, TRIM(dimuni2)) == 1) &
1828            .OR.(INDEX(str1, TRIM(dimuni3)) == 1) ) THEN
1829          vid = iv
1830          iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, ndims=ndim)
1831        ENDIF
1832      ENDIF
1833    ENDDO
1834  ENDIF
1835!-
1836! Second rule : we find specific names :
1837! lon : nav_lon
1838! lat : nav_lat
1839! Here we can check if we find the substring as the
1840! names are more specific.
1841!-
1842  SELECTCASE(axtype)
1843  CASE ('lon')
1844    dimname = 'nav_lon lon longitude'
1845    found_rule = .TRUE.
1846  CASE('lat')
1847    dimname = 'nav_lat lat latitude'
1848    found_rule = .TRUE.
1849  CASE('lev')
1850    dimname = 'plev level depth deptht'
1851    found_rule = .TRUE.
1852  CASE DEFAULT
1853    found_rule = .FALSE.
1854  END SELECT
1855!-
1856  IF (found_rule) THEN
1857    iv = 0
1858    DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
1859      iv = iv+1
1860      str1=''
1861      iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
1862                                    name=str1, ndims=ndim)
1863      IF (INDEX(dimname,TRIM(str1)) >= 1) THEN
1864        vid = iv
1865      ENDIF
1866    ENDDO
1867  ENDIF
1868!-
1869! Third rule : we find a variable with the same name as the dimension
1870! lon = 1
1871! lat = 2
1872! lev = 3
1873!-
1874  IF (vid < 0) THEN
1875    SELECTCASE(axtype)
1876    CASE ('lon')
1877      dimnb = 1
1878      found_rule = .TRUE.
1879    CASE('lat')
1880      dimnb = 2
1881      found_rule = .TRUE.
1882    CASE('lev')
1883      dimnb = 3
1884      found_rule = .TRUE.
1885    CASE DEFAULT
1886      found_rule = .FALSE.
1887    END SELECT
1888!---
1889    IF (found_rule) THEN
1890      iret = NF90_INQUIRE_DIMENSION (ncids(fid_in), dimnb, name=dimname)
1891      iv = 0
1892      DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
1893        iv = iv+1
1894        str1=''
1895        iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
1896                                      name=str1, ndims=ndim)
1897        IF (INDEX(dimname,TRIM(str1)) == 1) THEN
1898          vid = iv
1899        ENDIF
1900      ENDDO
1901    ENDIF
1902  ENDIF
1903!-
1904! Stop the program if no coordinate was found
1905!-
1906  IF (vid < 0) THEN
1907    CALL histerr (3,'flinfindcood', &
1908           'No coordinate axis was found in the file', &
1909           'The data in this file can not be used', axtype)
1910  ENDIF
1911!--------------------------
1912END SUBROUTINE flinfindcood
1913!-
1914!===
1915!-
1916SUBROUTINE flinclo (fid_in)
1917!---------------------------------------------------------------------
1918  IMPLICIT NONE
1919!-
1920  INTEGER :: fid_in
1921!-
1922  INTEGER :: iret
1923!---------------------------------------------------------------------
1924  iret = NF90_CLOSE (ncids(fid_in))
1925  ncfileopen(fid_in) = .FALSE.
1926!---------------------
1927END SUBROUTINE flinclo
1928!-
1929!===
1930!-
1931SUBROUTINE flinquery_var(fid_in, varname, exists)
1932!---------------------------------------------------------------------
1933!- Queries the existance of a variable in the file.
1934!---------------------------------------------------------------------
1935  IMPLICIT NONE
1936!-
1937  INTEGER :: fid_in
1938  CHARACTER(LEN=*) varname
1939  LOGICAL :: exists
1940!-
1941  INTEGER :: iret, fid, vid
1942!---------------------------------------------------------------------
1943  fid = ncids(fid_in)
1944  vid = -1
1945  iret = NF90_INQ_VARID (fid, varname, vid)
1946!-
1947  exists = ( (vid >= 0).AND.(iret == NF90_NOERR) )
1948!---------------------------
1949END SUBROUTINE flinquery_var
1950!-
1951!===
1952!-
1953SUBROUTINE flininspect (fid_in)
1954!---------------------------------------------------------------------
1955  IMPLICIT NONE
1956!-
1957! fid : File id to inspect
1958!-
1959  INTEGER :: fid_in
1960!-
1961!- LOCAL
1962!-
1963  INTEGER :: iim, jjm, llm, ttm, fid_out
1964  INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim
1965  INTEGER :: iv, in, lll
1966  INTEGER :: xid, yid, zid, tid
1967  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: idimid
1968  CHARACTER(LEN=80) :: name
1969  CHARACTER(LEN=30) :: axname
1970!---------------------------------------------------------------------
1971  fid = ncids(fid_in)
1972!-
1973  iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &
1974                       nAttributes=nb_atts, unlimitedDimId=id_unlim)
1975!-
1976  WRITE (*,*) 'IOIPSL ID                   : ',fid_in
1977  WRITE (*,*) 'NetCDF ID                   : ',fid
1978  WRITE (*,*) 'Number of dimensions        : ',ndims
1979  WRITE (*,*) 'Number of variables         : ',nvars
1980  WRITE (*,*) 'Number of global attributes : ',nb_atts
1981  WRITE (*,*) 'ID unlimited                : ',id_unlim
1982!-
1983  xid = -1; iim = 0;
1984  yid = -1; jjm = 0;
1985  zid = -1; llm = 0;
1986  tid = -1; ttm = 0;
1987!-
1988  DO iv=1,ndims
1989!---
1990    iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)
1991    CALL strlowercase (axname)
1992    axname = ADJUSTL(axname)
1993!---
1994    WRITE (*,*) 'Dimension number : ',iv
1995    WRITE (*,*) 'Dimension name   : ',TRIM(axname)
1996!---
1997    IF      (    (INDEX(axname,'x') == 1) &
1998             .OR.(INDEX(axname,'lon') == 1)) THEN
1999      xid = iv; iim = lll;
2000      WRITE (*,*) 'Dimension X size   : ',iim
2001    ELSE IF (    (INDEX(axname,'y') == 1) &
2002             .OR.(INDEX(axname,'lat') == 1)) THEN
2003      yid = iv; jjm = lll;
2004      WRITE (*,*) 'Dimension Y size   : ',jjm
2005    ELSE IF (    (INDEX(axname,'lev') == 1) &
2006             .OR.(INDEX(axname,'plev') == 1) &
2007             .OR.(INDEX(axname,'z') == 1) &
2008             .OR.(INDEX(axname,'depth') == 1)) THEN
2009      zid = iv; llm = lll;
2010      WRITE (*,*) 'Dimension Z size   : ',llm
2011    ELSE IF (    (INDEX(axname,'tstep') == 1) &
2012             .OR.(INDEX(axname,'time') == 1) &
2013             .OR.(INDEX(axname,'time_counter') == 1)) THEN
2014!---- For the time we certainly need to allow for other names
2015      tid = iv; ttm = lll;
2016    ELSE IF (ndims == 1) THEN
2017!---- Nothing was found and ndims=1 then we have a vector of data
2018      xid = 1; iim = lll;
2019    ENDIF
2020!---
2021  ENDDO
2022!-
2023! Keep all this information
2024!-
2025  nbfiles = nbfiles+1
2026!-
2027  IF (nbfiles > nbfile_max) THEN
2028    CALL histerr(3,'flininspect', &
2029      'Too many files. Please increase nbfil_max', &
2030      'in program flincom.F90.',' ')
2031  ENDIF
2032!-
2033  ncids(nbfiles) = fid
2034  ncnbd(nbfiles) = ndims
2035!-
2036  ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)
2037!-
2038  ncfunli(nbfiles) = id_unlim
2039  ncnba(nbfiles)   = nb_atts
2040  ncnbva(nbfiles)  = nvars
2041  ncfileopen(nbfiles) = .TRUE.
2042!-
2043  fid_out = nbfiles
2044!-
2045  DO in=1,nvars
2046    iret = NF90_INQUIRE_VARIABLE (fid, in, &
2047             name=name, ndims=ndims, dimids=idimid, nAtts=nb_atts)
2048    WRITE (*,*) 'Variable number  ------------ > ', in
2049    WRITE (*,*) 'Variable name        : ', TRIM(name)
2050    WRITE (*,*) 'Number of dimensions : ', ndims
2051    WRITE (*,*) 'Dimensions ID''s     : ', idimid(1:ndims)
2052    WRITE (*,*) 'Number of attributes : ', nb_atts
2053  ENDDO
2054!-------------------------
2055END SUBROUTINE flininspect
2056!-
2057!===
2058!-
2059END MODULE flincom
Note: See TracBrowser for help on using the repository browser.