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

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

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

revision 47 by guez, Tue Apr 6 17:52:58 2010 UTC revision 48 by guez, Tue Jul 19 12:54:20 2011 UTC
# Line 9  MODULE flinget_m Line 9  MODULE flinget_m
9    
10    INTERFACE flinget    INTERFACE flinget
11       MODULE PROCEDURE flinget_r3d, flinget_r2d       MODULE PROCEDURE flinget_r3d, flinget_r2d
12         ! The difference between the procedures is the rank of argument "var".
13    END INTERFACE    END INTERFACE
14    
15  CONTAINS  CONTAINS
16    
17    SUBROUTINE flinget_r2d &    SUBROUTINE flinget_r2d(fid_in, varname, iim, jjm, llm, ttm, itau_dep, &
18         (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)         itau_fin, var)
     !---------------------------------------------------------------------  
     IMPLICIT NONE  
19    
20      INTEGER :: fid_in      INTEGER, intent(in):: fid_in
21      CHARACTER(LEN=*) :: varname      CHARACTER(LEN=*), intent(in):: varname
22      INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin      INTEGER, intent(in):: iim, jjm, llm, ttm, itau_dep, itau_fin
23      REAL :: var(:,:)      REAL, intent(out):: var(:, :)
24    
25        ! Local:
26      INTEGER :: jl, jj, ji      INTEGER :: jl, jj, ji
27      REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp      REAL, DIMENSION(:), ALLOCATABLE, SAVE :: buff_tmp
28      LOGICAL :: check = .FALSE.      LOGICAL :: check = .FALSE.
29    
30      !---------------------------------------------------------------------      !---------------------------------------------------------------------
31    
32      IF (.NOT.ALLOCATED(buff_tmp)) THEN      IF (.NOT.ALLOCATED(buff_tmp)) THEN
33         IF (check) WRITE(*,*) &         IF (check) WRITE(*, *) &
34              "flinget_r2d : allocate buff_tmp for buff_sz = ",SIZE(var)              "flinget_r2d : allocate buff_tmp for buff_sz = ", SIZE(var)
35         ALLOCATE (buff_tmp(SIZE(var)))         ALLOCATE (buff_tmp(SIZE(var)))
36      ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN      ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
37         IF (check) WRITE(*,*) &         IF (check) WRITE(*, *) &
38              "flinget_r2d : re-allocate buff_tmp for buff_sz = ",SIZE(var)              "flinget_r2d : re-allocate buff_tmp for buff_sz = ", SIZE(var)
39         DEALLOCATE (buff_tmp)         DEALLOCATE (buff_tmp)
40         ALLOCATE (buff_tmp(SIZE(var)))         ALLOCATE (buff_tmp(SIZE(var)))
41      ENDIF      ENDIF
42    
43      CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &      CALL flinget_mat(fid_in, varname, iim, jjm, llm, ttm, itau_dep, &
44           itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)           itau_fin, 1, iim, 1, jjm, buff_tmp)
45    
46      jl=0      jl=0
47      DO jj=1,SIZE(var,2)      DO jj=1, SIZE(var, 2)
48         DO ji=1,SIZE(var,1)         DO ji=1, SIZE(var, 1)
49            jl=jl+1            jl=jl+1
50            var(ji,jj) = buff_tmp(jl)            var(ji, jj) = buff_tmp(jl)
51         ENDDO         ENDDO
52      ENDDO      ENDDO
53      !-------------------------  
54    END SUBROUTINE flinget_r2d    END SUBROUTINE flinget_r2d
55    
56    !===    !****************************************************************
57    
58    SUBROUTINE flinget_r3d(fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)    SUBROUTINE flinget_r3d(fid_in, varname, iim, jjm, llm, ttm, itau_dep, &
59      !---------------------------------------------------------------------         itau_fin, var)
     IMPLICIT NONE  
60    
61      INTEGER, intent(in):: fid_in      INTEGER, intent(in):: fid_in
62      CHARACTER(LEN=*), intent(in):: varname      CHARACTER(LEN=*), intent(in):: varname
63      INTEGER, intent(in):: iim, jjm, llm, ttm, itau_dep, itau_fin      INTEGER, intent(in):: iim, jjm, llm, ttm, itau_dep, itau_fin
64      REAL, intent(out):: var(:,:,:)      REAL, intent(out):: var(:, :, :)
65    
66        ! Local:
67      INTEGER :: jl, jk, jj, ji      INTEGER :: jl, jk, jj, ji
68      REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp      REAL, DIMENSION(:), ALLOCATABLE, SAVE :: buff_tmp
69      LOGICAL :: check = .FALSE.      LOGICAL :: check = .FALSE.
70    
71      !---------------------------------------------------------------------      !---------------------------------------------------------------------
72    
73      IF (.NOT.ALLOCATED(buff_tmp)) THEN      IF (.NOT.ALLOCATED(buff_tmp)) THEN
74         IF (check) WRITE(*,*) &         IF (check) WRITE(*, *) &
75              "flinget_r3d : allocate buff_tmp for buff_sz = ",SIZE(var)              "flinget_r3d : allocate buff_tmp for buff_sz = ", SIZE(var)
76         ALLOCATE (buff_tmp(SIZE(var)))         ALLOCATE (buff_tmp(SIZE(var)))
77      ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN      ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
78         IF (check) WRITE(*,*) &         IF (check) WRITE(*, *) &
79              "flinget_r3d : re-allocate buff_tmp for buff_sz = ",SIZE(var)              "flinget_r3d : re-allocate buff_tmp for buff_sz = ", SIZE(var)
80         DEALLOCATE (buff_tmp)         DEALLOCATE (buff_tmp)
81         ALLOCATE (buff_tmp(SIZE(var)))         ALLOCATE (buff_tmp(SIZE(var)))
82      ENDIF      ENDIF
83    
84      CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &      CALL flinget_mat (fid_in, varname, iim, jjm, llm, ttm, &
85           itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)           itau_dep, itau_fin, 1, iim, 1, jjm, buff_tmp)
86    
87      jl=0      jl=0
88      DO jk=1,SIZE(var,3)      DO jk=1, SIZE(var, 3)
89         DO jj=1,SIZE(var,2)         DO jj=1, SIZE(var, 2)
90            DO ji=1,SIZE(var,1)            DO ji=1, SIZE(var, 1)
91               jl=jl+1               jl=jl+1
92               var(ji,jj,jk) = buff_tmp(jl)               var(ji, jj, jk) = buff_tmp(jl)
93            ENDDO            ENDDO
94         ENDDO         ENDDO
95      ENDDO      ENDDO
96      !-------------------------  
97    END SUBROUTINE flinget_r3d    END SUBROUTINE flinget_r3d
98    
99    !===    !****************************************************************
100    
101    SUBROUTINE flinget_mat &    SUBROUTINE flinget_mat(fid_in, varname, iim, jjm, llm, ttm, itau_dep, &
        (fid_in, varname, iim, jjm, llm, ttm, itau_dep, &  
102         itau_fin, iideb, iilen, jjdeb, jjlen, var)         itau_fin, iideb, iilen, jjdeb, jjlen, var)
103      !---------------------------------------------------------------------  
104      !- This subroutine will read the variable named varname from      !- This subroutine will read the variable named varname from
105      !- the file previously opened by flinopen and identified by fid      !- the file previously opened by flinopen and identified by fid
106    
# Line 133  CONTAINS Line 136  CONTAINS
136      !- OUTPUT      !- OUTPUT
137    
138      !- var      : array that will contain the data      !- var      : array that will contain the data
139      !---------------------------------------------------------------------  
140      USE strlowercase_m,  ONLY : strlowercase      USE strlowercase_m,  ONLY : strlowercase
141      USE errioipsl, ONLY : histerr      USE errioipsl, ONLY : histerr
142      USE netcdf, ONLY : nf90_byte, nf90_double, nf90_float, nf90_get_att, &      USE netcdf, ONLY : nf90_byte, nf90_double, nf90_float, nf90_get_att, &
# Line 142  CONTAINS Line 145  CONTAINS
145           nf90_max_var_dims, nf90_noerr, nf90_short, nf90_strerror           nf90_max_var_dims, nf90_noerr, nf90_short, nf90_strerror
146      use flincom, only: ncids      use flincom, only: ncids
147    
     IMPLICIT NONE  
   
148      ! ARGUMENTS      ! ARGUMENTS
149    
150      INTEGER, intent(in):: fid_in      INTEGER, intent(in):: fid_in
# Line 160  CONTAINS Line 161  CONTAINS
161      INTEGER, SAVE :: cind_vid      INTEGER, SAVE :: cind_vid
162      INTEGER, SAVE :: cind_fid      INTEGER, SAVE :: cind_fid
163      INTEGER, SAVE :: cind_len      INTEGER, SAVE :: cind_len
164      INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: cindex      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: cindex
165      INTEGER,DIMENSION(4) :: w_sta, w_len, w_dim      INTEGER, DIMENSION(4) :: w_sta, w_len, w_dim
166      INTEGER :: iret, fid      INTEGER :: iret, fid
167      INTEGER :: vid, cvid, clen      INTEGER :: vid, cvid, clen
168      CHARACTER(LEN=70) :: str1      CHARACTER(LEN=70) :: str1
169      CHARACTER(LEN=250) :: att_n, tmp_n      CHARACTER(LEN=250) :: att_n, tmp_n
170      INTEGER :: tmp_i      INTEGER :: tmp_i
171      REAL,SAVE :: mis_v=0.      REAL, SAVE :: mis_v=0.
172      REAL :: tmp_r      REAL :: tmp_r
173      INTEGER :: ndims, x_typ, nb_atts      INTEGER :: ndims, x_typ, nb_atts
174      INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dimids      INTEGER, DIMENSION(NF90_MAX_VAR_DIMS) :: dimids
175      INTEGER :: i, i2d, cnd      INTEGER :: i, i2d, cnd
176      REAL,DIMENSION(:),ALLOCATABLE,SAVE :: var_tmp      REAL, DIMENSION(:), ALLOCATABLE, SAVE :: var_tmp
177      LOGICAL :: uncompress = .FALSE.      LOGICAL :: uncompress = .FALSE.
178      LOGICAL :: check = .FALSE.      LOGICAL :: check = .FALSE.
179    
180      !---------------------------------------------------------------------      !---------------------------------------------------------------------
181    
182      fid = ncids(fid_in)      fid = ncids(fid_in)
183    
184      IF (check) THEN      IF (check) THEN
185         WRITE(*,*) &         WRITE(*, *) &
186              'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname)              'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname)
187         WRITE(*,*) &         WRITE(*, *) &
188              'flinget_mat : iim, jjm, llm, ttm, itau_dep, itau_fin :', &              'flinget_mat : iim, jjm, llm, ttm, itau_dep, itau_fin :', &
189              iim, jjm, llm, ttm, itau_dep, itau_fin              iim, jjm, llm, ttm, itau_dep, itau_fin
190         WRITE(*,*) &         WRITE(*, *) &
191              'flinget_mat : iideb, iilen, jjdeb, jjlen :', &              'flinget_mat : iideb, iilen, jjdeb, jjlen :', &
192              iideb, iilen, jjdeb, jjlen              iideb, iilen, jjdeb, jjlen
193      ENDIF      ENDIF
# Line 197  CONTAINS Line 200  CONTAINS
200      iret = NF90_INQ_VARID (fid, varname, vid)      iret = NF90_INQ_VARID (fid, varname, vid)
201    
202      IF (vid < 0 .OR. iret /= NF90_NOERR) THEN      IF (vid < 0 .OR. iret /= NF90_NOERR) THEN
203         CALL histerr (3,'flinget', &         CALL histerr (3, 'flinget', &
204              'Variable '//TRIM(varname)//' not found in file',' ',' ')              'Variable '//TRIM(varname)//' not found in file', ' ', ' ')
205      ENDIF      ENDIF
206    
207      iret = NF90_INQUIRE_VARIABLE (fid, vid, &      iret = NF90_INQUIRE_VARIABLE (fid, vid, &
208           ndims=ndims, dimids=dimids, nAtts=nb_atts)           ndims=ndims, dimids=dimids, nAtts=nb_atts)
209      IF (check) THEN      IF (check) THEN
210         WRITE(*,*) &         WRITE(*, *) &
211              'flinget_mat : fid, vid :', fid, vid              'flinget_mat : fid, vid :', fid, vid
212         WRITE(*,*) &         WRITE(*, *) &
213              'flinget_mat : ndims, dimids(1:ndims), nb_atts :', &              'flinget_mat : ndims, dimids(1:ndims), nb_atts :', &
214              ndims, dimids(1:ndims), nb_atts              ndims, dimids(1:ndims), nb_atts
215      ENDIF      ENDIF
216    
217      w_dim(:) = 0      w_dim(:) = 0
218      DO i=1,ndims      DO i=1, ndims
219         iret  = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i))         iret  = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i))
220      ENDDO      ENDDO
221      IF (check) WRITE(*,*) &      IF (check) WRITE(*, *) &
222           'flinget_mat : w_dim :', w_dim(1:ndims)           'flinget_mat : w_dim :', w_dim(1:ndims)
223    
224      mis_v = 0.0      mis_v = 0.0
225    
226      IF (nb_atts > 0) THEN      IF (nb_atts > 0) THEN
227         IF (check) THEN         IF (check) THEN
228            WRITE(*,*) 'flinget_mat : attributes for variable :'            WRITE(*, *) 'flinget_mat : attributes for variable :'
229         ENDIF         ENDIF
230      ENDIF      ENDIF
231      DO i=1,nb_atts      DO i=1, nb_atts
232         iret = NF90_INQ_ATTNAME (fid, vid, i, att_n)         iret = NF90_INQ_ATTNAME (fid, vid, i, att_n)
233         iret = NF90_INQUIRE_ATTRIBUTE (fid, vid, att_n, xtype=x_typ)         iret = NF90_INQUIRE_ATTRIBUTE (fid, vid, att_n, xtype=x_typ)
234         CALL strlowercase (att_n)         CALL strlowercase (att_n)
# Line 233  CONTAINS Line 236  CONTAINS
236              .OR.(x_typ == NF90_BYTE) ) THEN              .OR.(x_typ == NF90_BYTE) ) THEN
237            iret = NF90_GET_ATT (fid, vid, att_n, tmp_i)            iret = NF90_GET_ATT (fid, vid, att_n, tmp_i)
238            IF (check) THEN            IF (check) THEN
239               WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_i               WRITE(*, *) '   ', TRIM(att_n), ' : ', tmp_i
240            ENDIF            ENDIF
241         ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN         ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN
242            iret = NF90_GET_ATT (fid, vid, att_n, tmp_r)            iret = NF90_GET_ATT (fid, vid, att_n, tmp_r)
243            IF (check) THEN            IF (check) THEN
244               WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_r               WRITE(*, *) '   ', TRIM(att_n), ' : ', tmp_r
245            ENDIF            ENDIF
246            IF (index(att_n,'missing_value') > 0) THEN            IF (index(att_n, 'missing_value') > 0) THEN
247               mis_v = tmp_r               mis_v = tmp_r
248            ENDIF            ENDIF
249         ELSE         ELSE
250            tmp_n = ''            tmp_n = ''
251            iret = NF90_GET_ATT (fid, vid, att_n, tmp_n)            iret = NF90_GET_ATT (fid, vid, att_n, tmp_n)
252            IF (check) THEN            IF (check) THEN
253               WRITE(*,*) '   ',TRIM(att_n),' : ',TRIM(tmp_n)               WRITE(*, *) '   ', TRIM(att_n), ' : ', TRIM(tmp_n)
254            ENDIF            ENDIF
255         ENDIF         ENDIF
256      ENDDO      ENDDO
# Line 267  CONTAINS Line 270  CONTAINS
270              name=tmp_n, len=clen)              name=tmp_n, len=clen)
271         iret = NF90_INQ_VARID (fid, tmp_n, cvid)         iret = NF90_INQ_VARID (fid, tmp_n, cvid)
272         !---         !---
273         IF (check) WRITE(*,*) &         IF (check) WRITE(*, *) &
274              'Dimname, iret , NF90_NOERR : ',TRIM(tmp_n),iret,NF90_NOERR              'Dimname, iret , NF90_NOERR : ', TRIM(tmp_n), iret, NF90_NOERR
275         !---         !---
276         !-- If we have an axis which has the same name         !-- If we have an axis which has the same name
277         !-- as the dimension we can see if it is compressed         !-- as the dimension we can see if it is compressed
# Line 279  CONTAINS Line 282  CONTAINS
282            iret = NF90_GET_ATT (fid, cvid, 'compress', str1)            iret = NF90_GET_ATT (fid, cvid, 'compress', str1)
283            !-----            !-----
284            IF (iret == NF90_NOERR) THEN            IF (iret == NF90_NOERR) THEN
285               iret = NF90_INQUIRE_VARIABLE (fid,cvid,xtype=x_typ,ndims=cnd)               iret = NF90_INQUIRE_VARIABLE (fid, cvid, xtype=x_typ, ndims=cnd)
286               !-------               !-------
287               IF ( cnd /= 1 .AND. x_typ /= NF90_INT) THEN               IF ( cnd /= 1 .AND. x_typ /= NF90_INT) THEN
288                  CALL histerr (3,'flinget', &                  CALL histerr (3, 'flinget', &
289                       'Variable '//TRIM(tmp_n)//' can not be a compressed axis', &                       'Variable '//TRIM(tmp_n)//' can not be a compressed axis', &
290                       'Either it has too many dimensions'// &                       'Either it has too many dimensions'// &
291                       ' or it is not of type integer', ' ')                       ' or it is not of type integer', ' ')
# Line 309  CONTAINS Line 312  CONTAINS
312               ENDIF               ENDIF
313            ELSE            ELSE
314               str1 = 'The horizontal dimensions of '//varname               str1 = 'The horizontal dimensions of '//varname
315               CALL histerr (3,'flinget',str1, &               CALL histerr (3, 'flinget', str1, &
316                    'is not compressed and does not'// &                    'is not compressed and does not'// &
317                    ' correspond to the requested size',' ')                    ' correspond to the requested size', ' ')
318            ENDIF            ENDIF
319         ELSE         ELSE
320            IF (w_dim(1) /= iim) THEN            IF (w_dim(1) /= iim) THEN
321               str1 = 'The longitude dimension of '//varname               str1 = 'The longitude dimension of '//varname
322               CALL histerr (3,'flinget',str1, &               CALL histerr (3, 'flinget', str1, &
323                    'in the file is not equal to the dimension', &                    'in the file is not equal to the dimension', &
324                    'that should be read')                    'that should be read')
325            ENDIF            ENDIF
326            IF (w_dim(2) /= jjm) THEN            IF (w_dim(2) /= jjm) THEN
327               str1 = 'The latitude dimension of '//varname               str1 = 'The latitude dimension of '//varname
328               CALL histerr (3,'flinget',str1, &               CALL histerr (3, 'flinget', str1, &
329                    'in the file is not equal to the dimension', &                    'in the file is not equal to the dimension', &
330                    'that should be read')                    'that should be read')
331            ENDIF            ENDIF
# Line 345  CONTAINS Line 348  CONTAINS
348         IF (llm == 1 .AND. ndims == i2d+2 .OR. llm == w_dim(i2d+1)) THEN         IF (llm == 1 .AND. ndims == i2d+2 .OR. llm == w_dim(i2d+1)) THEN
349            !-----            !-----
350            IF (w_dim(i2d+1) /= llm) THEN            IF (w_dim(i2d+1) /= llm) THEN
351               CALL histerr (3,'flinget', &               CALL histerr (3, 'flinget', &
352                    'The vertical dimension of '//varname, &                    'The vertical dimension of '//varname, &
353                    'in the file is not equal to the dimension', &                    'in the file is not equal to the dimension', &
354                    'that should be read')                    'that should be read')
# Line 360  CONTAINS Line 363  CONTAINS
363            !-----            !-----
364            IF ((itau_fin-itau_dep) >= 0) THEN            IF ((itau_fin-itau_dep) >= 0) THEN
365               IF      (ndims /= i2d+2) THEN               IF      (ndims /= i2d+2) THEN
366                  CALL histerr (3,'flinget', &                  CALL histerr (3, 'flinget', &
367                       'You attempt to read a time slab', &                       'You attempt to read a time slab', &
368                       'but there is no time axis on this variable', varname)                       'but there is no time axis on this variable', varname)
369               ELSE IF ((itau_fin - itau_dep) <= w_dim(i2d+2)) THEN               ELSE IF ((itau_fin - itau_dep) <= w_dim(i2d+2)) THEN
370                  w_sta(i2d+2) = itau_dep                  w_sta(i2d+2) = itau_dep
371                  w_len(i2d+2) = itau_fin-itau_dep+1                  w_len(i2d+2) = itau_fin-itau_dep+1
372               ELSE               ELSE
373                  CALL histerr (3,'flinget', &                  CALL histerr (3, 'flinget', &
374                       'The time step you try to read is not', &                       'The time step you try to read is not', &
375                       'in the file (1)', varname)                       'in the file (1)', varname)
376               ENDIF               ENDIF
377            ELSE IF (ndims == i2d+2 .AND. w_dim(i2d+2) > 1) THEN            ELSE IF (ndims == i2d+2 .AND. w_dim(i2d+2) > 1) THEN
378               CALL histerr (3,'flinget', &               CALL histerr (3, 'flinget', &
379                    'There is a time axis in the file but no', &                    'There is a time axis in the file but no', &
380                    'time step give in the call', varname)                    'time step give in the call', varname)
381            ELSE            ELSE
# Line 384  CONTAINS Line 387  CONTAINS
387            !---- 2.3.2 We do not have any vertical axis            !---- 2.3.2 We do not have any vertical axis
388            !-----            !-----
389            IF (ndims == i2d+2) THEN            IF (ndims == i2d+2) THEN
390               CALL histerr (3,'flinget', &               CALL histerr (3, 'flinget', &
391                    'The file contains 4 dimensions', &                    'The file contains 4 dimensions', &
392                    'but only 3 are requestes for variable ', varname)                    'but only 3 are requestes for variable ', varname)
393            ENDIF            ENDIF
# Line 394  CONTAINS Line 397  CONTAINS
397                     w_sta(i2d+1) = itau_dep                     w_sta(i2d+1) = itau_dep
398                     w_len(i2d+1) = itau_fin-itau_dep+1                     w_len(i2d+1) = itau_fin-itau_dep+1
399                  ELSE                  ELSE
400                     CALL histerr (3,'flinget', &                     CALL histerr (3, 'flinget', &
401                          'The time step you try to read is not', &                          'The time step you try to read is not', &
402                          'in the file (2)', varname)                          'in the file (2)', varname)
403                  ENDIF                  ENDIF
404               ELSE               ELSE
405                  CALL histerr (3,'flinget', &                  CALL histerr (3, 'flinget', &
406                       'From your input you sould have 3 dimensions', &                       'From your input you sould have 3 dimensions', &
407                       'in the file but there are 4', varname)                       'in the file but there are 4', varname)
408               ENDIF               ENDIF
409            ELSE            ELSE
410               IF (ndims == i2d+1 .AND. w_dim(i2d+1) > 1) THEN               IF (ndims == i2d+1 .AND. w_dim(i2d+1) > 1) THEN
411                  CALL histerr (3,'flinget', &                  CALL histerr (3, 'flinget', &
412                       'There is a time axis in the file but no', &                       'There is a time axis in the file but no', &
413                       'time step given in the call', varname)                       'time step given in the call', varname)
414               ELSE               ELSE
# Line 424  CONTAINS Line 427  CONTAINS
427    
428      ! 3.0 Reading the data      ! 3.0 Reading the data
429    
430      IF (check) WRITE(*,*) &      IF (check) WRITE(*, *) &
431           'flinget_mat 3.0 : ', uncompress, w_sta, w_len           'flinget_mat 3.0 : ', uncompress, w_sta, w_len
432      !---      !---
433      IF (uncompress) THEN      IF (uncompress) THEN
# Line 449  CONTAINS Line 452  CONTAINS
452              start=w_sta(:), count=w_len(:))              start=w_sta(:), count=w_len(:))
453      ENDIF      ENDIF
454    
455      IF (check) WRITE(*,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret)      IF (check) WRITE(*, *) 'flinget_mat 3.1 : ', NF90_STRERROR (iret)
456      !--------------------------  
457    END  SUBROUTINE flinget_mat    END  SUBROUTINE flinget_mat
458    
459  END MODULE flinget_m  END MODULE flinget_m
Legend:
Removed from v.47  
changed lines
  Added in v.48
  ViewVC Help
Powered by ViewVC 1.1.21