/[lmdze]/trunk/libf/IOIPSL/flincom.f90
ViewVC logotype

Diff of /trunk/libf/IOIPSL/flincom.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 30 by guez, Thu Apr 1 09:07:28 2010 UTC revision 36 by guez, Thu Dec 2 17:11:04 2010 UTC
# Line 2  MODULE flincom Line 2  MODULE flincom
2    
3    ! From flincom.f90, version 2.2 2006/03/07 09:21:51    ! From flincom.f90, version 2.2 2006/03/07 09:21:51
4    
   USE netcdf  
   
   USE calendar,  ONLY : ju2ymds, ymds2ju, ioconf_calendar  
   USE errioipsl, ONLY : histerr  
   USE stringop,  ONLY : strlowercase  
   
5    IMPLICIT NONE    IMPLICIT NONE
6    
7    PRIVATE    PRIVATE
8    PUBLIC flinput, flincre, flinget, flinget_zoom2d, flinclo    PUBLIC flinclo, flinopen_nozoom, flininfo, ncids
   public flinopen_nozoom  
   public flininfo, flininspect, flinquery_var  
   
   INTERFACE flinput  
      !---------------------------------------------------------------------  
      !- The "flinput" routines will put a variable  
      !- on the netCDF file created by flincre.  
      !- If the sizes of the axis do not match the one of the IDs  
      !- then a new axis is created.  
      !- That is we loose the possibility of writting hyperslabs of data.  
   
      !- Again here if iim = jjm = llm = ttm = 0  
      !- then a global attribute is added to the file.  
   
      !- INPUT  
   
      !- fid      : Identification of the file in which we will write  
      !- varname  : Name of variable to be written  
      !- iim      : size in x of variable  
      !- nlonid   : ID of x axis which could fit for this axis  
      !- jjm      : size in y of variable  
      !- nlatid   : ID of y axis which could fit for this axis  
      !- llm      : size in z of variable  
      !- zdimid   : ID of z axis which could fit for this axis  
      !- ttm      : size in t of variable  
      !- tdimid   : ID of t axis which could fit for this axis  
   
      !- OUTPUT  
   
      !- NONE  
      !---------------------------------------------------------------------  
      MODULE PROCEDURE flinput_r4d, flinput_r3d, flinput_r2d, &  
           flinput_r1d, flinput_scal  
   END INTERFACE  
   
   INTERFACE flinget  
      MODULE PROCEDURE flinget_r4d, flinget_r3d, flinget_r2d, flinget_r1d, &  
           flinget_scal  
   END INTERFACE  
   INTERFACE flinget_zoom2d  
      MODULE PROCEDURE flinget_r4d_zoom2d, flinget_r3d_zoom2d, &  
           flinget_r2d_zoom2d  
   END INTERFACE  
   
   ! This is the data we keep on each file we open  
   
   INTEGER, PARAMETER :: nbfile_max = 200  
   INTEGER, SAVE :: nbfiles = 0  
   INTEGER, SAVE :: ncids(nbfile_max), ncnbd(nbfile_max), &  
        ncfunli(nbfile_max), ncnba(nbfile_max)  
   INTEGER, SAVE :: ncnbva(nbfile_max), ncdims(nbfile_max,4)  
   LOGICAL, SAVE :: ncfileopen(nbfile_max)=.FALSE.  
   
   INTEGER, SAVE :: cind_vid, cind_fid, cind_len  
   INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: cindex  
9    
10    INTEGER,DIMENSION(4) :: w_sta, w_len, w_dim    ! This is the data we keep on each file we open:
11      INTEGER, PARAMETER:: nbfile_max = 200
12      INTEGER, SAVE:: ncids(nbfile_max)
13      INTEGER, SAVE:: ncnbva(nbfile_max)
14      LOGICAL, SAVE:: ncfileopen(nbfile_max)=.FALSE.
15    
16  CONTAINS  CONTAINS
17    
18    SUBROUTINE flincre &    SUBROUTINE flinopen_nozoom(iim, jjm, llm, lon, lat, lev, &
        (filename, iim1, jjm1, lon1, lat1, llm1, lev1, ttm1, itaus, &  
        time0, dt, fid_out, nlonid1, nlatid1, zdimid1, tdimid1)  
     !---------------------------------------------------------------------  
     !- This is a "low level" subroutine for opening netCDF files wich  
     !- contain the major coordinate system of the model.  
     !- Other coordinates needed for other variables  
     !- will be added as they are needed.  
   
     !- INPUT  
   
     !- filename    : Name of the file to be created  
     !- iim1, jjm1  : Horizontal size of the grid  
     !-               which will be stored in the file  
     !- lon1, lat1  : Horizontal grids  
     !- llm1        : Size of the vertical grid  
     !- lev1        : Vertical grid  
     !- ttm1        : Size of time axis  
     !- itaus       : time steps on the time axis  
     !- time0       : Time in julian days at which itau = 0  
     !- dt          : time step in seconds between itaus  
     !-               (one step of itau)  
   
     !- OUTPUT  
   
     !- fid         : File identification  
     !- nlonid1     : Identification of longitudinal axis  
     !- nlatid1     : Identification of latitudinal axis  
     !- zdimid1     : ID of vertical axis  
     !- tdimid1     : ID of time axis  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     ! ARGUMENTS  
   
     CHARACTER(LEN=*) :: filename  
     INTEGER :: iim1, jjm1, llm1, ttm1  
     REAL :: lon1(iim1,jjm1)  
     REAL :: lat1(iim1,jjm1)  
     REAL :: lev1(llm1)  
     INTEGER :: itaus(ttm1)  
     REAL :: time0  
     REAL :: dt  
     INTEGER :: fid_out, zdimid1, nlonid1, nlatid1, tdimid1  
   
     ! LOCAL  
   
     INTEGER :: iret, lll, fid  
     INTEGER :: lonid, latid, levid, timeid  
     INTEGER :: year, month, day  
     REAL :: sec  
     CHARACTER(LEN=250):: name  
   
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     lll = LEN_TRIM(filename)  
     IF (filename(lll-2:lll) /= '.nc') THEN  
        name=filename(1:lll)//'.nc'  
     ELSE  
        name=filename(1:lll)  
     ENDIF  
   
     iret = NF90_CREATE (name, NF90_CLOBBER, fid)  
   
     iret = NF90_DEF_DIM (fid, 'x',     iim1, nlonid1)  
     iret = NF90_DEF_DIM (fid, 'y',     jjm1, nlatid1)  
     iret = NF90_DEF_DIM (fid, 'lev',   llm1, zdimid1)  
     iret = NF90_DEF_DIM (fid, 'tstep', ttm1, tdimid1)  
   
     ! Vertical axis  
   
     IF (check) WRITE(*,*) 'flincre Vertical axis'  
   
     iret = NF90_DEF_VAR (fid, 'lev', NF90_FLOAT, zdimid1, levid)  
     iret = NF90_PUT_ATT (fid, levid, 'units',     '-')  
     iret = NF90_PUT_ATT (fid, levid, 'title',     'levels')  
     iret = NF90_PUT_ATT (fid, levid, 'long_name', 'Sigma Levels')  
   
     ! Time axis  
   
     IF (check) WRITE(*,*) 'flincre time axis'  
   
     iret = NF90_DEF_VAR (fid, 'tstep', NF90_FLOAT, tdimid1, timeid)  
     iret = NF90_PUT_ATT (fid, timeid, 'units',     '-')  
     iret = NF90_PUT_ATT (fid, timeid, 'title',     'time')  
     iret = NF90_PUT_ATT (fid, timeid, 'long_name', 'time steps')  
   
     ! The longitude  
   
     IF (check) WRITE(*,*) 'flincre Longitude axis'  
   
     iret = NF90_DEF_VAR (fid, "nav_lon", NF90_FLOAT, &  
          (/ nlonid1, nlatid1 /), lonid)  
     iret = NF90_PUT_ATT (fid, lonid, 'units', "degrees_east")  
     iret = NF90_PUT_ATT (fid, lonid, 'title', "Longitude")  
     iret = NF90_PUT_ATT (fid, lonid, 'nav_model', &  
          "Lambert projection of PROMES")  
     iret = NF90_PUT_ATT (fid, lonid, 'valid_min', &  
          REAL(MINVAL(lon1)))  
     iret = NF90_PUT_ATT (fid, lonid, 'valid_max', &  
          REAL(MAXVAL(lon1)))  
   
     ! The Latitude  
   
     IF (check) WRITE(*,*) 'flincre Latitude axis'  
   
     iret = NF90_DEF_VAR (fid, "nav_lat", NF90_FLOAT, &  
          (/ nlonid1, nlatid1 /), latid)  
     iret = NF90_PUT_ATT (fid, latid, 'units', "degrees_north")  
     iret = NF90_PUT_ATT (fid, latid, 'title', "Latitude")  
     iret = NF90_PUT_ATT (fid, latid, 'nav_model', &  
          "Lambert projection of PROMES")  
     iret = NF90_PUT_ATT (fid, latid, 'valid_min', &  
          REAL(MINVAL(lat1)))  
     iret = NF90_PUT_ATT (fid, latid, 'valid_max', &  
          REAL(MAXVAL(lat1)))  
   
     ! The time coordinates  
   
     iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', &  
          REAL(dt))  
   
     CALL ju2ymds (time0, year, month, day, sec)  
   
     iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'year0',  REAL(year))  
     iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'month0', REAL(month))  
     iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'day0',   REAL(day))  
     iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'sec0',   REAL(sec))  
   
     iret = NF90_ENDDEF (fid)  
   
     IF (check) WRITE(*,*) 'flincre Variable'  
   
     iret = NF90_PUT_VAR (fid, levid, lev1(1:llm1))  
   
     IF (check) WRITE(*,*) 'flincre Time Variable'  
   
     iret = NF90_PUT_VAR (fid, timeid, REAL(itaus(1:ttm1)))  
   
     IF (check) WRITE(*,*) 'flincre Longitude'  
   
     iret = NF90_PUT_VAR (fid, lonid, lon1(1:iim1,1:jjm1))  
   
     IF (check) WRITE(*,*) 'flincre Latitude'  
   
     iret = NF90_PUT_VAR (fid, latid, lat1(1:iim1,1:jjm1))  
   
     ! Keep all this information  
   
     nbfiles = nbfiles+1  
   
     IF (nbfiles > nbfile_max) THEN  
        CALL histerr (3,'flincre', &  
             'Too many files. Please increase nbfil_max', &  
             'in program flincom.F90.',' ')  
     ENDIF  
   
     ncids(nbfiles) = fid  
     ncnbd(nbfiles) = 4  
   
     ncdims(nbfiles,1:4) = (/ iim1, jjm1, llm1, ttm1 /)  
   
     ncfunli(nbfiles) = -1  
     ncnba(nbfiles)   =  4  
     ncnbva(nbfiles)  =  0  
     ncfileopen(nbfiles) = .TRUE.  
   
     fid_out = nbfiles  
     !---------------------  
   END SUBROUTINE flincre  
   
   !===  
   
   SUBROUTINE flinopen_nozoom(filename, iim, jjm, llm, lon, lat, lev, &  
19         ttm, itaus, date0, dt, fid_out)         ttm, itaus, date0, dt, fid_out)
20    
21      !- The routine will open an input file      ! The routine will open an input file
22      !- INPUT      ! INPUT
23      !- filename  : Name of the netCDF file to be opened      ! There is no test of the content of the file against the input
   
     !- There is no test of the content of the file against the input  
24      ! from the model      ! from the model
25    
26      !- iim       : size in the x direction in the file (longitude)      ! iim: size in the x direction in the file (longitude)
27      !- jjm       : size in the y direction      ! jjm: size in the y direction
28      !- llm       : number of levels      ! llm: number of levels
29      !-             (llm = 0 means no axis to be expected)      ! (llm = 0 means no axis to be expected)
30    
31      !- WARNING :      ! WARNING:
32      !- It is for the user to check      ! It is for the user to check
33      !- that the dimensions of lon lat and lev are correct when passed to      ! that the dimensions of lon lat and lev are correct when passed to
34      !- flinopen. This can be done after the call when iim and jjm have      ! flinopen. This can be done after the call when iim and jjm have
35      !- been retrieved from the netCDF file. In F90 this problem will      ! been retrieved from the netCDF file. In F90 this problem will
36      !- be solved with an internal assign      ! be solved with an internal assign
37      !- IF iim, jjm, llm or ttm are parameters in the calling program      ! IF iim, jjm, llm or ttm are parameters in the calling program
38      !- it will create a segmentation fault      ! it will create a segmentation fault
39    
40      !-  ttm       : size of time axis      ! ttm: size of time axis
41    
42      !-  OUTPUT      ! OUTPUT
43    
44      !- lon       : array of (iim,jjm),      ! lon: array of (iim, jjm),
45      !-             that contains the longitude of each point      ! that contains the longitude of each point
46      !- lat       : same for latitude      ! lat: same for latitude
47      !- lev       : An array of llm for the latitude      ! lev: An array of llm for the latitude
48      !-  itaus     : Time steps within this file      ! itaus: Time steps within this file
49      !-  date0     : Julian date at which itau = 0      ! date0: Julian date at which itau = 0
50      !-  dt        : length of the time steps of the data      ! dt: length of the time steps of the data
51        
52      !---------------------------------------------------------------------      !---------------------------------------------------------------------
53    
54      IMPLICIT NONE      USE calendar, ONLY: ymds2ju, ioconf_calendar
55        USE errioipsl, ONLY: histerr
56        USE netcdf, ONLY: nf90_get_att, nf90_get_var, nf90_global, &
57             nf90_inquire_variable
58    
59      ! ARGUMENTS      ! ARGUMENTS
60    
61      CHARACTER(LEN=*), intent(in):: filename      INTEGER, intent(in):: iim, jjm, llm, ttm
62      INTEGER, intent(in) :: iim, jjm, llm, ttm      real, intent(out):: lon(iim, jjm), lat(iim, jjm), lev(llm)
     real, intent(out):: lon(iim,jjm), lat(iim,jjm), lev(llm)  
63      INTEGER, intent(out):: itaus(ttm)      INTEGER, intent(out):: itaus(ttm)
64      REAL, intent(out):: date0, dt      REAL, intent(out):: date0, dt
65    
# Line 298  CONTAINS Line 68  CONTAINS
68    
69      ! LOCAL      ! LOCAL
70    
71      INTEGER :: iret, vid, fid, nbdim, i      INTEGER:: iret, vid, fid, nbdim, i
72      INTEGER :: gdtt_id, old_id, iv, gdtmaf_id      INTEGER:: gdtt_id, old_id, iv, gdtmaf_id
73      CHARACTER(LEN=250) :: name      CHARACTER(LEN=250):: name
74      CHARACTER(LEN=80) :: units, calendar      CHARACTER(LEN=80):: units, my_calendar
75      INTEGER :: year, month, day      INTEGER:: year, month, day
76      REAL :: r_year, r_month, r_day      REAL:: r_year, r_month, r_day
77      INTEGER :: year0, month0, day0, hours0, minutes0, seci      INTEGER:: year0, month0, day0, hours0, minutes0, seci
78      REAL :: sec, sec0      REAL:: sec, sec0
79      CHARACTER :: strc      CHARACTER:: strc
80    
81      REAL,DIMENSION(:),ALLOCATABLE :: vec_tmp      REAL, DIMENSION(:), ALLOCATABLE:: vec_tmp
82    
83      !---------------------------------------------------------------------      !---------------------------------------------------------------------
84    
# Line 324  CONTAINS Line 94  CONTAINS
94         stop 1         stop 1
95      end IF      end IF
96    
97      !-- The user has already opened the file      ! The user has already opened the file
98      !-- and we trust that he knows the dimensions      ! and we trust that he knows the dimensions
99    
100      fid = ncids(fid_out)      fid = ncids(fid_out)
101    
102      ! 2.0 get the sizes and names of the different coordinates      ! 2.0 get the sizes and names of the different coordinates
103      !     and do a first set of verification.      ! and do a first set of verification.
104    
105      ! 3.0 Check if we are realy talking about the same coodinate system      ! 3.0 Check if we are realy talking about the same coodinate system
106      !     if not then we get the lon, lat and lev variables from the file      ! if not then we get the lon, lat and lev variables from the file
107    
108        ! 4.0 extracting the coordinates
109    
     !-- 4.0 extracting the coordinates  
     !---  
110      CALL flinfindcood (fid_out, 'lon', vid, nbdim)      CALL flinfindcood (fid_out, 'lon', vid, nbdim)
111      IF (nbdim == 2) THEN      IF (nbdim == 2) THEN
112         iret = NF90_GET_VAR (fid, vid, lon, &         iret = NF90_GET_VAR (fid, vid, lon, &
# Line 345  CONTAINS Line 115  CONTAINS
115         ALLOCATE(vec_tmp(iim))         ALLOCATE(vec_tmp(iim))
116         iret = NF90_GET_VAR (fid, vid, vec_tmp, &         iret = NF90_GET_VAR (fid, vid, vec_tmp, &
117              start=(/ 1 /), count=(/ iim /))              start=(/ 1 /), count=(/ iim /))
118         DO i=1,jjm         DO i=1, jjm
119            lon(:,i) = vec_tmp(:)            lon(:, i) = vec_tmp(:)
120         ENDDO         ENDDO
121         DEALLOCATE(vec_tmp)         DEALLOCATE(vec_tmp)
122      ENDIF      ENDIF
123      !---  
124      CALL flinfindcood (fid_out, 'lat', vid, nbdim)      CALL flinfindcood (fid_out, 'lat', vid, nbdim)
125      IF (nbdim == 2) THEN      IF (nbdim == 2) THEN
126         iret = NF90_GET_VAR (fid, vid, lat, &         iret = NF90_GET_VAR (fid, vid, lat, &
# Line 359  CONTAINS Line 129  CONTAINS
129         ALLOCATE(vec_tmp(jjm))         ALLOCATE(vec_tmp(jjm))
130         iret = NF90_GET_VAR (fid, vid, vec_tmp, &         iret = NF90_GET_VAR (fid, vid, vec_tmp, &
131              start=(/ 1 /), count=(/ jjm /))              start=(/ 1 /), count=(/ jjm /))
132         DO i=1,iim         DO i=1, iim
133            lat(i,:) = vec_tmp(:)            lat(i, :) = vec_tmp(:)
134         ENDDO         ENDDO
135         DEALLOCATE(vec_tmp)         DEALLOCATE(vec_tmp)
136      ENDIF      ENDIF
137      !---  
138      IF (llm > 0) THEN      IF (llm > 0) THEN
139         CALL flinfindcood (fid_out, 'lev', vid, nbdim)         CALL flinfindcood (fid_out, 'lev', vid, nbdim)
140         IF (nbdim == 1) THEN         IF (nbdim == 1) THEN
141            iret = NF90_GET_VAR (fid, vid, lev, &            iret = NF90_GET_VAR (fid, vid, lev, &
142                 start=(/ 1 /), count=(/ llm /))                 start=(/ 1 /), count=(/ llm /))
143         ELSE         ELSE
144            CALL histerr (3,'flinopen', &            CALL histerr (3, 'flinopen', &
145                 'Can not handle vertical coordinates that have more',&                 'Can not handle vertical coordinates that have more', &
146                 'than 1 dimension',' ')                 'than 1 dimension', ' ')
147         ENDIF         ENDIF
148      ENDIF      ENDIF
149    
150      ! 5.0 Get all the details for the time if possible needed      ! 5.0 Get all the details for the time if possible needed
151    
152      IF (ttm > 0) THEN      IF (ttm > 0) THEN
153         !---  
154         !-- 5.1 Find the time axis. Prefered method is the 'timestep since'         ! 5.1 Find the time axis. Prefered method is the 'timestep since'
155         !---  
156         gdtmaf_id = -1         gdtmaf_id = -1
157         gdtt_id = -1         gdtt_id = -1
158         old_id = -1         old_id = -1
159         DO iv=1,ncnbva(fid_out)         DO iv=1, ncnbva(fid_out)
160            name=''            name=''
161            iret = NF90_INQUIRE_VARIABLE (fid, iv, name=name)            iret = NF90_INQUIRE_VARIABLE (fid, iv, name=name)
162            units=''            units=''
163            iret = NF90_GET_ATT (fid, iv, 'units', units)            iret = NF90_GET_ATT (fid, iv, 'units', units)
164            IF (INDEX(units,'seconds since') > 0) gdtmaf_id = iv            IF (INDEX(units, 'seconds since') > 0) gdtmaf_id = iv
165            IF (INDEX(units,'timesteps since') > 0) gdtt_id = iv            IF (INDEX(units, 'timesteps since') > 0) gdtt_id = iv
166            IF (INDEX(name, 'tstep') > 0) old_id = iv            IF (INDEX(name, 'tstep') > 0) old_id = iv
167         ENDDO         ENDDO
168         !---  
169         IF (gdtt_id > 0) THEN         IF (gdtt_id > 0) THEN
170            vid = gdtt_id            vid = gdtt_id
171         ELSE IF (gdtmaf_id > 0) THEN         ELSE IF (gdtmaf_id > 0) THEN
# Line 403  CONTAINS Line 173  CONTAINS
173         ELSE IF (old_id > 0) THEN         ELSE IF (old_id > 0) THEN
174            vid = old_id            vid = old_id
175         ELSE         ELSE
176            CALL histerr (3, 'flinopen', 'No time axis found',' ',' ')            CALL histerr (3, 'flinopen', 'No time axis found', ' ', ' ')
177         ENDIF         ENDIF
178         !---  
179         ALLOCATE(vec_tmp(ttm))         ALLOCATE(vec_tmp(ttm))
180         iret = NF90_GET_VAR (fid, vid, vec_tmp, &         iret = NF90_GET_VAR (fid, vid, vec_tmp, &
181              start=(/ 1 /), count=(/ ttm /))              start=(/ 1 /), count=(/ ttm /))
182         itaus(1:ttm) = NINT(vec_tmp(1:ttm))         itaus(1:ttm) = NINT(vec_tmp(1:ttm))
183         DEALLOCATE(vec_tmp)         DEALLOCATE(vec_tmp)
184         !---  
185         !-- Getting all the details for the time axis         ! Getting all the details for the time axis
186         !---  
187         !-- Find the calendar         ! Find the calendar
188         calendar='XXXX'         my_calendar='XXXX'
189         iret = NF90_GET_ATT (fid, gdtmaf_id, 'calendar', calendar)         iret = NF90_GET_ATT (fid, gdtmaf_id, 'calendar', my_calendar)
190         IF ( INDEX(calendar,'XXXX') < 1 ) THEN         IF ( INDEX(my_calendar, 'XXXX') < 1 ) THEN
191            CALL ioconf_calendar(calendar)            CALL ioconf_calendar(my_calendar)
192         ENDIF         ENDIF
193         !--  
194         units = ''         units = ''
195         iret = NF90_GET_ATT (fid, vid, 'units', units)         iret = NF90_GET_ATT (fid, vid, 'units', units)
196         IF (gdtt_id > 0) THEN         IF (gdtt_id > 0) THEN
197            units = units(INDEX(units,'since')+6:LEN_TRIM(units))            units = units(INDEX(units, 'since')+6:LEN_TRIM(units))
198            READ (units,'(I4.4,5(a,I2.2))') &            READ (units, '(I4.4, 5(a, I2.2))') &
199                 year0, strc, month0, strc, day0, &                 year0, strc, month0, strc, day0, &
200                 strc, hours0, strc, minutes0, strc, seci                 strc, hours0, strc, minutes0, strc, seci
201            sec0 = hours0*3600. + minutes0*60. + seci            sec0 = hours0*3600. + minutes0*60. + seci
202            CALL ymds2ju (year0, month0, day0, sec0, date0)            CALL ymds2ju (year0, month0, day0, sec0, date0)
203            iret = NF90_GET_ATT (fid, gdtt_id, 'tstep_sec', dt)            iret = NF90_GET_ATT (fid, gdtt_id, 'tstep_sec', dt)
204         ELSE IF (gdtmaf_id > 0) THEN         ELSE IF (gdtmaf_id > 0) THEN
205            units = units(INDEX(units,'since')+6:LEN_TRIM(units))            units = units(INDEX(units, 'since')+6:LEN_TRIM(units))
206            READ (units,'(I4.4,5(a,I2.2))') &            READ (units, '(I4.4, 5(a, I2.2))') &
207                 year0, strc, month0, strc, day0, &                 year0, strc, month0, strc, day0, &
208                 strc, hours0, strc, minutes0, strc, seci                 strc, hours0, strc, minutes0, strc, seci
209            sec0 = hours0*3600. + minutes0*60. + seci            sec0 = hours0*3600. + minutes0*60. + seci
210            CALL ymds2ju (year0, month0, day0, sec0, date0)            CALL ymds2ju (year0, month0, day0, sec0, date0)
211            !-----  
212         ELSE IF (old_id > 0) THEN         ELSE IF (old_id > 0) THEN
213            iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', dt)            iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', dt)
214            iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'day0', r_day)            iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'day0', r_day)
215            iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'sec0', sec)            iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'sec0', sec)
216            iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'year0', r_year)            iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'year0', r_year)
217            iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'month0', r_month)            iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'month0', r_month)
218            !-----  
219            day = INT(r_day)            day = INT(r_day)
220            month = INT(r_month)            month = INT(r_month)
221            year = INT(r_year)            year = INT(r_year)
222            !-----  
223            CALL ymds2ju (year, month, day, sec, date0)            CALL ymds2ju (year, month, day, sec, date0)
224         ENDIF         ENDIF
225      ENDIF      ENDIF
226    
227    END SUBROUTINE flinopen_nozoom    END SUBROUTINE flinopen_nozoom
228    
229    !===    !***************************************************************
230    
231    SUBROUTINE flininfo (filename, iim, jjm, llm, ttm, fid_out)    SUBROUTINE flininfo(filename, iim, jjm, llm, ttm, fid_out)
     !---------------------------------------------------------------------  
     !- This subroutine allows to get some information.  
     !- It is usualy done within flinopen but the user may want to call  
     !- it before in order to allocate the space needed to extract the  
     !- data from the file.  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
232    
233      ! ARGUMENTS      ! This subroutine allows to get some information.
234        ! It is usualy done within flinopen but the user may want to call
235        ! it before in order to allocate the space needed to extract the
236        ! data from the file.
237    
238        USE strlowercase_m, ONLY: strlowercase
239        USE errioipsl, ONLY: histerr
240        USE netcdf, ONLY: nf90_inquire, nf90_inquire_dimension, nf90_noerr, &
241             nf90_nowrite
242        use netcdf95, only: nf95_open
243    
244      CHARACTER(LEN=*), intent(in):: filename      CHARACTER(LEN=*), intent(in):: filename
245      INTEGER, intent(out):: iim, jjm, llm, ttm, fid_out      INTEGER, intent(out):: iim, jjm, llm, ttm, fid_out
246    
247      ! LOCAL      ! LOCAL
248    
249      INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim      INTEGER, SAVE:: nbfiles = 0
250      INTEGER :: iv, lll      INTEGER, SAVE:: ncdims(nbfile_max, 4)
251      CHARACTER(LEN=80) :: name      INTEGER:: iret, fid, ndims, nvars, nb_atts, id_unlim
252      CHARACTER(LEN=30) :: axname      INTEGER:: iv, lll
253        CHARACTER(LEN=80):: name
254        CHARACTER(LEN=30):: axname
255    
     LOGICAL :: check = .FALSE.  
256      !---------------------------------------------------------------------      !---------------------------------------------------------------------
257    
258      lll = LEN_TRIM(filename)      lll = LEN_TRIM(filename)
259      IF (filename(lll-2:lll) /= '.nc') THEN      IF (filename(lll-2:lll) /= '.nc') THEN
260         name = filename(1:lll)//'.nc'         name = filename(1:lll)//'.nc'
# Line 488  CONTAINS Line 262  CONTAINS
262         name = filename(1:lll)         name = filename(1:lll)
263      ENDIF      ENDIF
264    
265      iret = NF90_OPEN (name, NF90_NOWRITE, fid)      call NF95_OPEN(name, NF90_NOWRITE, fid)
266      IF (iret /= NF90_NOERR) THEN      iret = NF90_INQUIRE(fid, nDimensions=ndims, nVariables=nvars, &
        CALL histerr(3, 'flininfo','Could not open file :',TRIM(name),' ')  
     ENDIF  
   
     iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &  
267           nAttributes=nb_atts, unlimitedDimId=id_unlim)           nAttributes=nb_atts, unlimitedDimId=id_unlim)
268    
269      iim = 0;      iim = 0
270      jjm = 0;      jjm = 0
271      llm = 0;      llm = 0
272      ttm = 0;      ttm = 0
273    
274      DO iv=1,ndims      DO iv=1, ndims
275         !---         iret = NF90_INQUIRE_DIMENSION(fid, iv, name=axname, len=lll)
276         iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)         CALL strlowercase(axname)
        CALL strlowercase (axname)  
277         axname = ADJUSTL(axname)         axname = ADJUSTL(axname)
278         !---  
279         IF (check) WRITE(*,*) &         IF ((INDEX(axname, 'x') == 1) .OR. (INDEX(axname, 'lon') == 1)) THEN
280              'flininfo - getting axname',iv,axname,lll            iim = lll
281         !---         ELSE IF ((INDEX(axname, 'y') == 1) &
282         IF      (    (INDEX(axname,'x') == 1) &              .OR. (INDEX(axname, 'lat') == 1)) THEN
283              .OR.(INDEX(axname,'lon') == 1) ) THEN            jjm = lll
284            iim = lll;         ELSE IF ((INDEX(axname, 'lev') == 1) .OR. (INDEX(axname, 'plev') == 1) &
285         ELSE IF (    (INDEX(axname,'y') == 1) &              .OR. (INDEX(axname, 'z') == 1) &
286              .OR.(INDEX(axname,'lat') == 1) ) THEN              .OR. (INDEX(axname, 'depth') == 1)) THEN
287            jjm = lll;            llm = lll
288         ELSE IF (    (INDEX(axname,'lev') == 1) &         ELSE IF ((INDEX(axname, 'tstep') == 1) &
289              .OR.(INDEX(axname,'plev') == 1) &              .OR. (INDEX(axname, 'time_counter') == 1)) THEN
290              .OR.(INDEX(axname,'z') == 1) &            ! For the time we certainly need to allow for other names
291              .OR.(INDEX(axname,'depth') == 1) ) THEN            ttm = lll
           llm = lll;  
        ELSE IF (    (INDEX(axname,'tstep') == 1) &  
             .OR.(INDEX(axname,'time_counter') == 1) ) THEN  
           !---- For the time we certainly need to allow for other names  
           ttm = lll;  
292         ELSE IF (ndims == 1) THEN         ELSE IF (ndims == 1) THEN
293            !---- Nothing was found and ndims=1 then we have a vector of data            ! Nothing was found and ndims=1 then we have a vector of data
294            iim = lll;            iim = lll
295         ENDIF         ENDIF
        !---  
296      ENDDO      ENDDO
297    
298      ! Keep all this information      ! Keep all this information
# Line 537  CONTAINS Line 300  CONTAINS
300      nbfiles = nbfiles+1      nbfiles = nbfiles+1
301    
302      IF (nbfiles > nbfile_max) THEN      IF (nbfiles > nbfile_max) THEN
303         CALL histerr (3,'flininfo', &         CALL histerr(3, 'flininfo', &
304              'Too many files. Please increase nbfil_max', &              'Too many files. Please increase nbfil_max', &
305              'in program flincom.F90.',' ')              'in program flincom.F90.', ' ')
306      ENDIF      ENDIF
307    
308      ncids(nbfiles) = fid      ncids(nbfiles) = fid
309      ncnbd(nbfiles) = ndims      ncdims(nbfiles, :) = (/ iim, jjm, llm, ttm /)
310        ncnbva(nbfiles) = nvars
     ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)  
   
     ncfunli(nbfiles) = id_unlim  
     ncnba(nbfiles)   = nb_atts  
     ncnbva(nbfiles)  = nvars  
311      ncfileopen(nbfiles) = .TRUE.      ncfileopen(nbfiles) = .TRUE.
   
312      fid_out = nbfiles      fid_out = nbfiles
     !----------------------  
   END SUBROUTINE flininfo  
   
   !===  
   
   SUBROUTINE flinput_r1d &  
        (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid  
     REAL :: var(:)  
   
     INTEGER :: fid, ncvarid, ndim, iret  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (check) WRITE(*,*) &  
          "flinput_r1d : SIZE(var) = ",SIZE(var)  
   
     CALL flinput_mat &  
          (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &  
          fid,ncvarid,ndim)  
   
     iret = NF90_PUT_VAR (fid, ncvarid, var, &  
          start=w_sta(1:ndim), count=w_len(1:ndim))  
     !-------------------------  
   END SUBROUTINE flinput_r1d  
   
   !===  
   
   SUBROUTINE flinput_r2d &  
        (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid  
     REAL :: var(:,:)  
   
     INTEGER :: fid, ncvarid, ndim, iret  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (check) WRITE(*,*) &  
          "flinput_r2d : SIZE(var) = ",SIZE(var)  
   
     CALL flinput_mat &  
          (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &  
          fid,ncvarid,ndim)  
   
     iret = NF90_PUT_VAR (fid, ncvarid, var, &  
          start=w_sta(1:ndim), count=w_len(1:ndim))  
     !-------------------------  
   END SUBROUTINE flinput_r2d  
   
   !===  
   
   SUBROUTINE flinput_r3d &  
        (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid  
     REAL :: var(:,:,:)  
   
     INTEGER :: fid, ncvarid, ndim, iret  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (check) WRITE(*,*) &  
          "flinput_r3d : SIZE(var) = ",SIZE(var)  
   
     CALL flinput_mat &  
          (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &  
          fid,ncvarid,ndim)  
   
     iret = NF90_PUT_VAR (fid, ncvarid, var, &  
          start=w_sta(1:ndim), count=w_len(1:ndim))  
     !-------------------------  
   END SUBROUTINE flinput_r3d  
   
   !===  
   
   SUBROUTINE flinput_r4d &  
        (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid  
     REAL :: var(:,:,:,:)  
   
     INTEGER :: fid, ncvarid, ndim, iret  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (check) WRITE(*,*) &  
          "flinput_r4d : SIZE(var) = ",SIZE(var)  
   
     CALL flinput_mat &  
          (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &  
          fid,ncvarid,ndim)  
   
     iret = NF90_PUT_VAR (fid, ncvarid, var, &  
          start=w_sta(1:ndim), count=w_len(1:ndim))  
     !-------------------------  
   END SUBROUTINE flinput_r4d  
   
   !===  
   
   SUBROUTINE flinput_mat &  
        (fid_in,varname,iim,nlonid,jjm,nlatid, &  
        llm,zdimid,ttm,tdimid,fid,ncvarid,ndim)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid  
     INTEGER :: fid, ncvarid, ndim  
313    
314      ! LOCAL    END SUBROUTINE flininfo
   
     INTEGER :: iret  
     !---------------------------------------------------------------------  
     fid = ncids(fid_in)  
   
     w_sta(1:4) = (/      1,      1,  1,  1 /)  
     w_len(1:2) = (/    iim,    jjm /)  
     w_dim(1:2) = (/ nlonid, nlatid /)  
   
     IF ( (llm > 0).AND.(ttm > 0) ) THEN  
        ndim = 4  
        w_len(3:4) = (/    llm,    ttm /)  
        w_dim(3:4) = (/ zdimid, tdimid /)  
     ELSE IF (llm > 0) THEN  
        ndim = 3  
        w_dim(3) = zdimid  
        w_len(3) = llm  
     ELSE IF (ttm > 0) THEN  
        ndim = 3  
        w_dim(3) = tdimid  
        w_len(3) = ttm  
     ELSE  
        ndim = 2  
     ENDIF  
   
     iret = NF90_REDEF   (fid)  
     iret = NF90_DEF_VAR (fid,varname,NF90_FLOAT,w_dim(1:ndim),ncvarid)  
     iret = NF90_PUT_ATT (fid,ncvarid,'short_name',TRIM(varname))  
     iret = NF90_ENDDEF  (fid)  
     !--------------------------  
   END  SUBROUTINE flinput_mat  
   
   !===  
   
   SUBROUTINE flinput_scal &  
        (fid_in, varname, iim, nlonid, jjm, nlatid, &  
        llm, zdimid, ttm, tdimid, var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid  
     REAL :: var  
   
     ! LOCAL  
   
     INTEGER :: fid, iret  
     !---------------------------------------------------------------------  
     fid = ncids(fid_in)  
   
     iret = NF90_REDEF   (fid)  
     iret = NF90_PUT_ATT (fid, NF90_GLOBAL, varname, REAL(var))  
     iret = NF90_ENDDEF  (fid)  
     !---------------------------  
   END  SUBROUTINE flinput_scal  
   
   !===  
   
   SUBROUTINE flinget_r1d &  
        (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin  
     REAL :: var(:)  
   
     INTEGER :: jl, ji  
     REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (.NOT.ALLOCATED(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r1d : allocate buff_tmp for buff_sz = ",SIZE(var)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r1d : re-allocate buff_tmp for buff_sz = ",SIZE(var)  
        DEALLOCATE (buff_tmp)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ENDIF  
   
     CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &  
          itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)  
   
     jl=0  
     DO ji=1,SIZE(var,1)  
        jl=jl+1  
        var(ji) = buff_tmp(jl)  
     ENDDO  
     !-------------------------  
   END SUBROUTINE flinget_r1d  
   
   !===  
   
   SUBROUTINE flinget_r2d &  
        (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin  
     REAL :: var(:,:)  
   
     INTEGER :: jl, jj, ji  
     REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (.NOT.ALLOCATED(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r2d : allocate buff_tmp for buff_sz = ",SIZE(var)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r2d : re-allocate buff_tmp for buff_sz = ",SIZE(var)  
        DEALLOCATE (buff_tmp)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ENDIF  
   
     CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &  
          itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)  
   
     jl=0  
     DO jj=1,SIZE(var,2)  
        DO ji=1,SIZE(var,1)  
           jl=jl+1  
           var(ji,jj) = buff_tmp(jl)  
        ENDDO  
     ENDDO  
     !-------------------------  
   END SUBROUTINE flinget_r2d  
   
   !===  
   
   SUBROUTINE flinget_r2d_zoom2d &  
        (fid_in,varname,iim,jjm,llm,ttm, &  
        itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen  
     REAL :: var(:,:)  
   
     INTEGER :: jl, jj, ji  
     REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (.NOT.ALLOCATED(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r2d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r2d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)  
        DEALLOCATE (buff_tmp)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ENDIF  
   
     CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &  
          itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)  
   
     jl=0  
     DO jj=1,SIZE(var,2)  
        DO ji=1,SIZE(var,1)  
           jl=jl+1  
           var(ji,jj) = buff_tmp(jl)  
        ENDDO  
     ENDDO  
     !--------------------------------  
   END SUBROUTINE flinget_r2d_zoom2d  
   
   !===  
   
   SUBROUTINE flinget_r3d(fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER, intent(in):: fid_in  
     CHARACTER(LEN=*), intent(in):: varname  
     INTEGER, intent(in):: iim, jjm, llm, ttm, itau_dep, itau_fin  
     REAL, intent(out):: var(:,:,:)  
   
     INTEGER :: jl, jk, jj, ji  
     REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (.NOT.ALLOCATED(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r3d : allocate buff_tmp for buff_sz = ",SIZE(var)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r3d : re-allocate buff_tmp for buff_sz = ",SIZE(var)  
        DEALLOCATE (buff_tmp)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ENDIF  
   
     CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &  
          itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)  
   
     jl=0  
     DO jk=1,SIZE(var,3)  
        DO jj=1,SIZE(var,2)  
           DO ji=1,SIZE(var,1)  
              jl=jl+1  
              var(ji,jj,jk) = buff_tmp(jl)  
           ENDDO  
        ENDDO  
     ENDDO  
     !-------------------------  
   END SUBROUTINE flinget_r3d  
   
   !===  
   
   SUBROUTINE flinget_r3d_zoom2d &  
        (fid_in,varname,iim,jjm,llm,ttm, &  
        itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen  
     REAL :: var(:,:,:)  
   
     INTEGER :: jl, jk, jj, ji  
     REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (.NOT.ALLOCATED(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r3d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r3d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)  
        DEALLOCATE (buff_tmp)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ENDIF  
   
     CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &  
          itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)  
   
     jl=0  
     DO jk=1,SIZE(var,3)  
        DO jj=1,SIZE(var,2)  
           DO ji=1,SIZE(var,1)  
              jl=jl+1  
              var(ji,jj,jk) = buff_tmp(jl)  
           ENDDO  
        ENDDO  
     ENDDO  
     !--------------------------------  
   END SUBROUTINE flinget_r3d_zoom2d  
   
   !===  
   
   SUBROUTINE flinget_r4d &  
        (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin  
     REAL :: var(:,:,:,:)  
   
     INTEGER :: jl, jk, jj, ji, jm  
     REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (.NOT.ALLOCATED(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r4d : allocate buff_tmp for buff_sz = ",SIZE(var)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r4d : re-allocate buff_tmp for buff_sz = ",SIZE(var)  
        DEALLOCATE (buff_tmp)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ENDIF  
   
     CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &  
          itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)  
   
     jl=0  
     DO jm=1,SIZE(var,4)  
        DO jk=1,SIZE(var,3)  
           DO jj=1,SIZE(var,2)  
              DO ji=1,SIZE(var,1)  
                 jl=jl+1  
                 var(ji,jj,jk,jm) = buff_tmp(jl)  
              ENDDO  
           ENDDO  
        ENDDO  
     ENDDO  
     !-------------------------  
   END SUBROUTINE flinget_r4d  
   
   !===  
   
   SUBROUTINE flinget_r4d_zoom2d &  
        (fid_in,varname,iim,jjm,llm,ttm, &  
        itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen  
     REAL :: var(:,:,:,:)  
   
     INTEGER :: jl, jk, jj, ji, jm  
     REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (.NOT.ALLOCATED(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r4d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN  
        IF (check) WRITE(*,*) &  
             "flinget_r4d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)  
        DEALLOCATE (buff_tmp)  
        ALLOCATE (buff_tmp(SIZE(var)))  
     ENDIF  
   
     CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &  
          itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)  
   
     jl=0  
     DO jm=1,SIZE(var,4)  
        DO jk=1,SIZE(var,3)  
           DO jj=1,SIZE(var,2)  
              DO ji=1,SIZE(var,1)  
                 jl=jl+1  
                 var(ji,jj,jk,jm) = buff_tmp(jl)  
              ENDDO  
           ENDDO  
        ENDDO  
     ENDDO  
     !--------------------------------  
   END SUBROUTINE flinget_r4d_zoom2d  
   
   !===  
   
   SUBROUTINE flinget_mat &  
        (fid_in, varname, iim, jjm, llm, ttm, itau_dep, &  
        itau_fin, iideb, iilen, jjdeb, jjlen, var)  
     !---------------------------------------------------------------------  
     !- This subroutine will read the variable named varname from  
     !- the file previously opened by flinopen and identified by fid  
   
     !- It is checked that the dimensions of the variable to be read  
     !- correspond to what the user requested when he specified  
     !- iim, jjm and llm. The only exception which is allowed is  
     !- for compressed data where the horizontal grid is not expected  
     !- to be iim x jjm.  
   
     !- If variable is of size zero a global attribute is read.  
     !- This global attribute will be of type real  
   
     !- INPUT  
   
     !- fid      : File ID returned by flinopen  
     !- varname  : Name of the variable to be read from the file  
     !- iim      : | These three variables give the size of the variables  
     !- jjm      : | to be read. It will be verified that the variables  
     !- llm      : | fits in there.  
     !- ttm      : |  
     !- itau_dep : Time step at which we will start to read  
     !- itau_fin : Time step until which we are going to read  
     !-            For the moment this is done on indexes  
     !-            but it should be in the physical space.  
     !-            If there is no time-axis in the file then use a  
     !-            itau_fin < itau_dep, this will tell flinget not to  
     !-            expect a time-axis in the file.  
     !- iideb    : index i for zoom  
     !- iilen    : length of zoom  
     !- jjdeb    : index j for zoom  
     !- jjlen    : length of zoom  
   
     !- OUTPUT  
   
     !- var      : array that will contain the data  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     ! ARGUMENTS  
   
     INTEGER, intent(in):: fid_in  
     CHARACTER(LEN=*), intent(in):: varname  
     INTEGER, intent(in):: iim, jjm, llm, ttm, itau_dep, itau_fin  
     INTEGER :: iideb  
     integer, intent(in):: iilen  
     integer jjdeb  
     integer, intent(in):: jjlen  
     REAL :: var(:)  
   
     ! LOCAL  
   
     INTEGER :: iret, fid  
     INTEGER :: vid, cvid, clen  
     CHARACTER(LEN=70) :: str1  
     CHARACTER(LEN=250) :: att_n, tmp_n  
     CHARACTER(LEN=5) :: axs_l  
     INTEGER :: tmp_i  
     REAL,SAVE :: mis_v=0.  
     REAL :: tmp_r  
     INTEGER :: ndims, x_typ, nb_atts  
     INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dimids  
     INTEGER :: i, iv, nvars, i2d, cnd  
     REAL,DIMENSION(:),ALLOCATABLE,SAVE :: var_tmp  
     LOGICAL :: uncompress = .FALSE.  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     fid = ncids(fid_in)  
   
     IF (check) THEN  
        WRITE(*,*) &  
             'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname)  
        WRITE(*,*) &  
             'flinget_mat : iim, jjm, llm, ttm, itau_dep, itau_fin :', &  
             iim, jjm, llm, ttm, itau_dep, itau_fin  
        WRITE(*,*) &  
             'flinget_mat : iideb, iilen, jjdeb, jjlen :', &  
             iideb, iilen, jjdeb, jjlen  
     ENDIF  
   
     uncompress = .FALSE.  
   
     ! 1.0 We get first all the details on this variable from the file  
   
     nvars = ncnbva(fid_in)  
   
     vid = -1  
     iret = NF90_INQ_VARID (fid, varname, vid)  
   
     IF (vid < 0 .OR. iret /= NF90_NOERR) THEN  
        CALL histerr (3,'flinget', &  
             'Variable '//TRIM(varname)//' not found in file',' ',' ')  
     ENDIF  
   
     iret = NF90_INQUIRE_VARIABLE (fid, vid, &  
          ndims=ndims, dimids=dimids, nAtts=nb_atts)  
     IF (check) THEN  
        WRITE(*,*) &  
             'flinget_mat : fid, vid :', fid, vid  
        WRITE(*,*) &  
             'flinget_mat : ndims, dimids(1:ndims), nb_atts :', &  
             ndims, dimids(1:ndims), nb_atts  
     ENDIF  
   
     w_dim(:) = 0  
     DO i=1,ndims  
        iret  = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i))  
     ENDDO  
     IF (check) WRITE(*,*) &  
          'flinget_mat : w_dim :', w_dim(1:ndims)  
   
     mis_v = 0.0; axs_l = ' ';  
   
     IF (nb_atts > 0) THEN  
        IF (check) THEN  
           WRITE(*,*) 'flinget_mat : attributes for variable :'  
        ENDIF  
     ENDIF  
     DO i=1,nb_atts  
        iret = NF90_INQ_ATTNAME (fid, vid, i, att_n)  
        iret = NF90_INQUIRE_ATTRIBUTE (fid, vid, att_n, xtype=x_typ)  
        CALL strlowercase (att_n)  
        IF      (    (x_typ == NF90_INT).OR.(x_typ == NF90_SHORT) &  
             .OR.(x_typ == NF90_BYTE) ) THEN  
           iret = NF90_GET_ATT (fid, vid, att_n, tmp_i)  
           IF (check) THEN  
              WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_i  
           ENDIF  
        ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN  
           iret = NF90_GET_ATT (fid, vid, att_n, tmp_r)  
           IF (check) THEN  
              WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_r  
           ENDIF  
           IF (index(att_n,'missing_value') > 0) THEN  
              mis_v = tmp_r  
           ENDIF  
        ELSE  
           tmp_n = ''  
           iret = NF90_GET_ATT (fid, vid, att_n, tmp_n)  
           IF (check) THEN  
              WRITE(*,*) '   ',TRIM(att_n),' : ',TRIM(tmp_n)  
           ENDIF  
           IF (index(att_n,'axis') > 0) THEN  
              axs_l = tmp_n  
           ENDIF  
        ENDIF  
     ENDDO  
     !?  
 !!!!!!!!!! We will need a verification on the type of the variable  
     !?  
   
     ! 2.0 The dimensions are analysed to determine what is to be read  
   
     ! 2.1 the longitudes  
   
     IF ( w_dim(1) /= iim .OR. w_dim(2) /= jjm) THEN  
        !---  
        !-- There is a possibility that we have to deal with a compressed axis !  
        !---  
        iret = NF90_INQUIRE_DIMENSION (fid, dimids(1), &  
             name=tmp_n, len=clen)  
        iret = NF90_INQ_VARID (fid, tmp_n, cvid)  
        !---  
        IF (check) WRITE(*,*) &  
             'Dimname, iret , NF90_NOERR : ',TRIM(tmp_n),iret,NF90_NOERR  
        !---  
        !-- If we have an axis which has the same name  
        !-- as the dimension we can see if it is compressed  
        !---  
        !-- TODO TODO for zoom2d  
        !---  
        IF (iret == NF90_NOERR) THEN  
           iret = NF90_GET_ATT (fid, cvid, 'compress', str1)  
           !-----  
           IF (iret == NF90_NOERR) THEN  
              iret = NF90_INQUIRE_VARIABLE (fid,cvid,xtype=x_typ,ndims=cnd)  
              !-------  
              IF ( cnd /= 1 .AND. x_typ /= NF90_INT) THEN  
                 CALL histerr (3,'flinget', &  
                      'Variable '//TRIM(tmp_n)//' can not be a compressed axis', &  
                      'Either it has too many dimensions'// &  
                      ' or it is not of type integer', ' ')  
              ELSE  
                 !---------  
                 !-------- Let us see if we already have that index table  
                 !---------  
                 IF (    (cind_len /= clen).OR.(cind_vid /= cvid) &  
                      .OR.(cind_fid /= fid) ) THEN  
                    IF (ALLOCATED(cindex))   DEALLOCATE(cindex)  
                    ALLOCATE(cindex(clen))  
                    cind_len = clen  
                    cind_vid = cvid  
                    cind_fid = fid  
                    iret = NF90_GET_VAR (fid, cvid, cindex)  
                 ENDIF  
                 !---------  
                 !-------- In any case we need to set the slab of data to be read  
                 !---------  
                 uncompress = .TRUE.  
                 w_sta(1) = 1  
                 w_len(1) = clen  
                 i2d = 1  
              ENDIF  
           ELSE  
              str1 = 'The horizontal dimensions of '//varname  
              CALL histerr (3,'flinget',str1, &  
                   'is not compressed and does not'// &  
                   ' correspond to the requested size',' ')  
           ENDIF  
        ELSE  
           IF (w_dim(1) /= iim) THEN  
              str1 = 'The longitude dimension of '//varname  
              CALL histerr (3,'flinget',str1, &  
                   'in the file is not equal to the dimension', &  
                   'that should be read')  
           ENDIF  
           IF (w_dim(2) /= jjm) THEN  
              str1 = 'The latitude dimension of '//varname  
              CALL histerr (3,'flinget',str1, &  
                   'in the file is not equal to the dimension', &  
                   'that should be read')  
           ENDIF  
        ENDIF  
     ELSE  
        w_sta(1:2) = (/ iideb, jjdeb /)  
        w_len(1:2) = (/ iilen, jjlen /)  
        i2d = 2  
     ENDIF  
   
     ! 2.3 Now the difficult part, the 3rd dimension which can be  
     ! time or levels.  
   
     ! Priority is given to the time axis if only three axes are present.  
   
     IF (ndims > i2d) THEN  
        !---  
        !-- 2.3.1 We have a vertical axis  
        !---  
        IF (llm == 1 .AND. ndims == i2d+2 .OR. llm == w_dim(i2d+1)) THEN  
           !-----  
           IF (w_dim(i2d+1) /= llm) THEN  
              CALL histerr (3,'flinget', &  
                   'The vertical dimension of '//varname, &  
                   'in the file is not equal to the dimension', &  
                   'that should be read')  
           ELSE  
              w_sta(i2d+1) = 1  
              IF (llm > 0) THEN  
                 w_len(i2d+1) = llm  
              ELSE  
                 w_len(i2d+1) = w_sta(i2d+1)  
              ENDIF  
           ENDIF  
           !-----  
           IF ((itau_fin-itau_dep) >= 0) THEN  
              IF      (ndims /= i2d+2) THEN  
                 CALL histerr (3,'flinget', &  
                      'You attempt to read a time slab', &  
                      'but there is no time axis on this variable', varname)  
              ELSE IF ((itau_fin - itau_dep) <= w_dim(i2d+2)) THEN  
                 w_sta(i2d+2) = itau_dep  
                 w_len(i2d+2) = itau_fin-itau_dep+1  
              ELSE  
                 CALL histerr (3,'flinget', &  
                      'The time step you try to read is not', &  
                      'in the file (1)', varname)  
              ENDIF  
           ELSE IF (ndims == i2d+2 .AND. w_dim(i2d+2) > 1) THEN  
              CALL histerr (3,'flinget', &  
                   'There is a time axis in the file but no', &  
                   'time step give in the call', varname)  
           ELSE  
              w_sta(i2d+2) = 1  
              w_len(i2d+2) = 1  
           ENDIF  
        ELSE  
           !-----  
           !---- 2.3.2 We do not have any vertical axis  
           !-----  
           IF (ndims == i2d+2) THEN  
              CALL histerr (3,'flinget', &  
                   'The file contains 4 dimensions', &  
                   'but only 3 are requestes for variable ', varname)  
           ENDIF  
           IF ((itau_fin-itau_dep) >= 0) THEN  
              IF (ndims == i2d+1) THEN  
                 IF ((itau_fin-itau_dep) < w_dim(i2d+1) ) THEN  
                    w_sta(i2d+1) = itau_dep  
                    w_len(i2d+1) = itau_fin-itau_dep+1  
                 ELSE  
                    CALL histerr (3,'flinget', &  
                         'The time step you try to read is not', &  
                         'in the file (2)', varname)  
                 ENDIF  
              ELSE  
                 CALL histerr (3,'flinget', &  
                      'From your input you sould have 3 dimensions', &  
                      'in the file but there are 4', varname)  
              ENDIF  
           ELSE  
              IF (ndims == i2d+1 .AND. w_dim(i2d+1) > 1) THEN  
                 CALL histerr (3,'flinget', &  
                      'There is a time axis in the file but no', &  
                      'time step given in the call', varname)  
              ELSE  
                 w_sta(i2d+1) = 1  
                 w_len(i2d+1) = 1  
              ENDIF  
           ENDIF  
        ENDIF  
     ELSE  
        !---  
        !-- 2.3.3 We do not have any vertical axis  
        !---  
        w_sta(i2d+1:i2d+2) = (/ 0, 0 /)  
        w_len(i2d+1:i2d+2) = (/ 0, 0 /)  
     ENDIF  
   
     ! 3.0 Reading the data  
   
     IF (check) WRITE(*,*) &  
          'flinget_mat 3.0 : ', uncompress, w_sta, w_len  
     !---  
     IF (uncompress) THEN  
        !---  
        IF (ALLOCATED(var_tmp)) THEN  
           IF (SIZE(var_tmp) < clen) THEN  
              DEALLOCATE(var_tmp)  
              ALLOCATE(var_tmp(clen))  
           ENDIF  
        ELSE  
           ALLOCATE(var_tmp(clen))  
        ENDIF  
        !---  
        iret = NF90_GET_VAR (fid, vid, var_tmp, &  
             start=w_sta(:), count=w_len(:))  
        !---  
        var(:) = mis_v  
        var(cindex(:)) = var_tmp(:)  
        !---  
     ELSE  
        iret = NF90_GET_VAR (fid, vid, var, &  
             start=w_sta(:), count=w_len(:))  
     ENDIF  
   
     IF (check) WRITE(*,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret)  
     !--------------------------  
   END  SUBROUTINE flinget_mat  
   
   !===  
   
   SUBROUTINE flinget_scal &  
        (fid_in, varname, iim, jjm, llm, ttm, itau_dep, itau_fin, var)  
     !---------------------------------------------------------------------  
     !- This subroutine will read the variable named varname from  
     !- the file previously opened by flinopen and identified by fid  
   
     !- If variable is of size zero a global attribute is read. This  
     !- global attribute will be of type real  
   
     !- INPUT  
   
     !- fid      : File ID returned by flinopen  
     !- varname  : Name of the variable to be read from the file  
     !- iim      : | These three variables give the size of the variables  
     !- jjm      : | to be read. It will be verified that the variables  
     !- llm      : | fits in there.  
     !- ttm      : |  
     !- itau_dep : Time step at which we will start to read  
     !- itau_fin : Time step until which we are going to read  
     !-           For the moment this is done on indeces but it should be  
     !-           in the physical space  
     !-           If there is no time-axis in the file then use a  
     !-           itau_fin < itau_dep, this will tell flinget not to  
     !-           expect a time-axis in the file.  
   
     !- OUTPUT  
   
     !- var      : scalar that will contain the data  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     ! ARGUMENTS  
   
     INTEGER :: fid_in  
     CHARACTER(LEN=*) :: varname  
     INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin  
     REAL :: var  
   
     ! LOCAL  
   
     INTEGER :: iret, fid  
   
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     fid = ncids(fid_in)  
315    
316      ! 1.0 Reading a global attribute    !***************************************************************
317    
318      iret = NF90_GET_ATT (fid, NF90_GLOBAL, varname, var)    SUBROUTINE flinfindcood (fid_in, axtype, vid, ndim)
     !---------------------------  
   END  SUBROUTINE flinget_scal  
319    
320    !===      ! This subroutine explores the file in order to find
321        ! the coordinate according to a number of rules
322    
323    SUBROUTINE flinfindcood (fid_in, axtype, vid, ndim)      USE strlowercase_m, ONLY: strlowercase
324      !---------------------------------------------------------------------      USE errioipsl, ONLY: histerr
325      !- This subroutine explores the file in order to find      USE netcdf, ONLY: nf90_get_att, nf90_inquire_dimension, &
326      !- the coordinate according to a number of rules           nf90_inquire_variable, nf90_noerr
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
327    
328      ! ARGUMENTS      ! ARGUMENTS
329    
330      INTEGER, intent(in):: fid_in      INTEGER, intent(in):: fid_in
331      integer vid, ndim      integer vid, ndim
332      CHARACTER(LEN=3) :: axtype      CHARACTER(LEN=3):: axtype
333    
334      ! LOCAL      ! LOCAL
335    
336      INTEGER :: iv, iret, dimnb      INTEGER:: iv, iret, dimnb
337      CHARACTER(LEN=40) :: dimname, dimuni1, dimuni2, dimuni3      CHARACTER(LEN=40):: dimname, dimuni1, dimuni2, dimuni3
338      CHARACTER(LEN=30) :: str1      CHARACTER(LEN=30):: str1
339      LOGICAL :: found_rule = .FALSE.      LOGICAL:: found_rule = .FALSE.
340      !---------------------------------------------------------------------      !---------------------------------------------------------------------
341      vid = -1      vid = -1
342    
# Line 1466  CONTAINS Line 347  CONTAINS
347      dimuni2 = '?-?'      dimuni2 = '?-?'
348      dimuni3 = '?-?'      dimuni3 = '?-?'
349    
350      ! First rule : we look for the correct units      ! First rule: we look for the correct units
351      ! lon : east      ! lon: east
352      ! lat : north      ! lat: north
353      ! We make an exact check as it would be too easy to mistake      ! We make an exact check as it would be too easy to mistake
354      ! some units by just comparing the substrings.      ! some units by just comparing the substrings.
355    
# Line 1498  CONTAINS Line 379  CONTAINS
379            iret = NF90_GET_ATT (ncids(fid_in), iv, 'units', str1)            iret = NF90_GET_ATT (ncids(fid_in), iv, 'units', str1)
380            IF (iret == NF90_NOERR) THEN            IF (iret == NF90_NOERR) THEN
381               CALL strlowercase (str1)               CALL strlowercase (str1)
382               IF (    (INDEX(str1, TRIM(dimuni1)) == 1) &               IF ( (INDEX(str1, TRIM(dimuni1)) == 1) &
383                    .OR.(INDEX(str1, TRIM(dimuni2)) == 1) &                    .OR.(INDEX(str1, TRIM(dimuni2)) == 1) &
384                    .OR.(INDEX(str1, TRIM(dimuni3)) == 1) ) THEN                    .OR.(INDEX(str1, TRIM(dimuni3)) == 1) ) THEN
385                  vid = iv                  vid = iv
# Line 1508  CONTAINS Line 389  CONTAINS
389         ENDDO         ENDDO
390      ENDIF      ENDIF
391    
392      ! Second rule : we find specific names :      ! Second rule: we find specific names:
393      ! lon : nav_lon      ! lon: nav_lon
394      ! lat : nav_lat      ! lat: nav_lat
395      ! Here we can check if we find the substring as the      ! Here we can check if we find the substring as the
396      ! names are more specific.      ! names are more specific.
397    
# Line 1535  CONTAINS Line 416  CONTAINS
416            str1=''            str1=''
417            iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &            iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
418                 name=str1, ndims=ndim)                 name=str1, ndims=ndim)
419            IF (INDEX(dimname,TRIM(str1)) >= 1) THEN            IF (INDEX(dimname, TRIM(str1)) >= 1) THEN
420               vid = iv               vid = iv
421            ENDIF            ENDIF
422         ENDDO         ENDDO
423      ENDIF      ENDIF
424    
425      ! Third rule : we find a variable with the same name as the dimension      ! Third rule: we find a variable with the same name as the dimension
426      ! lon = 1      ! lon = 1
427      ! lat = 2      ! lat = 2
428      ! lev = 3      ! lev = 3
# Line 1560  CONTAINS Line 441  CONTAINS
441         CASE DEFAULT         CASE DEFAULT
442            found_rule = .FALSE.            found_rule = .FALSE.
443         END SELECT         END SELECT
444         !---  
445         IF (found_rule) THEN         IF (found_rule) THEN
446            iret = NF90_INQUIRE_DIMENSION (ncids(fid_in), dimnb, name=dimname)            iret = NF90_INQUIRE_DIMENSION (ncids(fid_in), dimnb, name=dimname)
447            iv = 0            iv = 0
# Line 1569  CONTAINS Line 450  CONTAINS
450               str1=''               str1=''
451               iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &               iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
452                    name=str1, ndims=ndim)                    name=str1, ndims=ndim)
453               IF (INDEX(dimname,TRIM(str1)) == 1) THEN               IF (INDEX(dimname, TRIM(str1)) == 1) THEN
454                  vid = iv                  vid = iv
455               ENDIF               ENDIF
456            ENDDO            ENDDO
# Line 1579  CONTAINS Line 460  CONTAINS
460      ! Stop the program if no coordinate was found      ! Stop the program if no coordinate was found
461    
462      IF (vid < 0) THEN      IF (vid < 0) THEN
463         CALL histerr (3,'flinfindcood', &         CALL histerr (3, 'flinfindcood', &
464              'No coordinate axis was found in the file', &              'No coordinate axis was found in the file', &
465              'The data in this file can not be used', axtype)              'The data in this file can not be used', axtype)
466      ENDIF      ENDIF
467      !--------------------------  
468    END SUBROUTINE flinfindcood    END SUBROUTINE flinfindcood
469    
470    !===    !***************************************************************
471    
472    SUBROUTINE flinclo (fid_in)    SUBROUTINE flinclo (fid_in)
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
   
     INTEGER :: fid_in  
   
     INTEGER :: iret  
     !---------------------------------------------------------------------  
     iret = NF90_CLOSE (ncids(fid_in))  
     ncfileopen(fid_in) = .FALSE.  
     !---------------------  
   END SUBROUTINE flinclo  
   
   !===  
   
   SUBROUTINE flinquery_var(fid_in, varname, exists)  
     !---------------------------------------------------------------------  
     !- Queries the existance of a variable in the file.  
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
473    
474      INTEGER :: fid_in      USE netcdf, ONLY: nf90_close
     CHARACTER(LEN=*) varname  
     LOGICAL :: exists  
475    
476      INTEGER :: iret, fid, vid      INTEGER:: fid_in
     !---------------------------------------------------------------------  
     fid = ncids(fid_in)  
     vid = -1  
     iret = NF90_INQ_VARID (fid, varname, vid)  
   
     exists = ( (vid >= 0).AND.(iret == NF90_NOERR) )  
     !---------------------------  
   END SUBROUTINE flinquery_var  
477    
478    !===      INTEGER:: iret
479    
   SUBROUTINE flininspect (fid_in)  
480      !---------------------------------------------------------------------      !---------------------------------------------------------------------
     IMPLICIT NONE  
   
     ! fid : File id to inspect  
   
     INTEGER :: fid_in  
   
     !- LOCAL  
481    
482      INTEGER :: iim, jjm, llm, ttm      iret = NF90_CLOSE (ncids(fid_in))
483      INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim      ncfileopen(fid_in) = .FALSE.
     INTEGER :: iv, in, lll  
     INTEGER :: xid, yid, zid, tid  
     INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: idimid  
     CHARACTER(LEN=80) :: name  
     CHARACTER(LEN=30) :: axname  
     !---------------------------------------------------------------------  
     fid = ncids(fid_in)  
   
     iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &  
          nAttributes=nb_atts, unlimitedDimId=id_unlim)  
   
     WRITE (*,*) 'IOIPSL ID                   : ',fid_in  
     WRITE (*,*) 'NetCDF ID                   : ',fid  
     WRITE (*,*) 'Number of dimensions        : ',ndims  
     WRITE (*,*) 'Number of variables         : ',nvars  
     WRITE (*,*) 'Number of global attributes : ',nb_atts  
     WRITE (*,*) 'ID unlimited                : ',id_unlim  
   
     xid = -1; iim = 0;  
     yid = -1; jjm = 0;  
     zid = -1; llm = 0;  
     tid = -1; ttm = 0;  
   
     DO iv=1,ndims  
        !---  
        iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)  
        CALL strlowercase (axname)  
        axname = ADJUSTL(axname)  
        !---  
        WRITE (*,*) 'Dimension number : ',iv  
        WRITE (*,*) 'Dimension name   : ',TRIM(axname)  
        !---  
        IF      (    (INDEX(axname,'x') == 1) &  
             .OR.(INDEX(axname,'lon') == 1)) THEN  
           xid = iv; iim = lll;  
           WRITE (*,*) 'Dimension X size   : ',iim  
        ELSE IF (    (INDEX(axname,'y') == 1) &  
             .OR.(INDEX(axname,'lat') == 1)) THEN  
           yid = iv; jjm = lll;  
           WRITE (*,*) 'Dimension Y size   : ',jjm  
        ELSE IF (    (INDEX(axname,'lev') == 1) &  
             .OR.(INDEX(axname,'plev') == 1) &  
             .OR.(INDEX(axname,'z') == 1) &  
             .OR.(INDEX(axname,'depth') == 1)) THEN  
           zid = iv; llm = lll;  
           WRITE (*,*) 'Dimension Z size   : ',llm  
        ELSE IF (    (INDEX(axname,'tstep') == 1) &  
             .OR.(INDEX(axname,'time_counter') == 1)) THEN  
           !---- For the time we certainly need to allow for other names  
           tid = iv; ttm = lll;  
        ELSE IF (ndims == 1) THEN  
           !---- Nothing was found and ndims=1 then we have a vector of data  
           xid = 1; iim = lll;  
        ENDIF  
        !---  
     ENDDO  
   
     ! Keep all this information  
   
     nbfiles = nbfiles+1  
   
     IF (nbfiles > nbfile_max) THEN  
        CALL histerr(3,'flininspect', &  
             'Too many files. Please increase nbfil_max', &  
             'in program flincom.F90.',' ')  
     ENDIF  
   
     ncids(nbfiles) = fid  
     ncnbd(nbfiles) = ndims  
   
     ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)  
   
     ncfunli(nbfiles) = id_unlim  
     ncnba(nbfiles)   = nb_atts  
     ncnbva(nbfiles)  = nvars  
     ncfileopen(nbfiles) = .TRUE.  
   
     DO in=1,nvars  
        iret = NF90_INQUIRE_VARIABLE (fid, in, &  
             name=name, ndims=ndims, dimids=idimid, nAtts=nb_atts)  
        WRITE (*,*) 'Variable number  ------------ > ', in  
        WRITE (*,*) 'Variable name        : ', TRIM(name)  
        WRITE (*,*) 'Number of dimensions : ', ndims  
        WRITE (*,*) 'Dimensions ID''s     : ', idimid(1:ndims)  
        WRITE (*,*) 'Number of attributes : ', nb_atts  
     ENDDO  
     !-------------------------  
   END SUBROUTINE flininspect  
484    
485    !===    END SUBROUTINE flinclo
486    
487  END MODULE flincom  END MODULE flincom
Legend:
Removed from v.30  
changed lines
  Added in v.36
  ViewVC Help
Powered by ViewVC 1.1.21