/[MITgcm]/MITgcm/pkg/mnc/mnc_file.F
ViewVC logotype

Diff of /MITgcm/pkg/mnc/mnc_file.F

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

revision 1.5 by edhill, Thu Jan 8 07:24:47 2004 UTC revision 1.12 by edhill, Wed Feb 4 05:45:09 2004 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "MNC_OPTIONS.h"  #include "MNC_OPTIONS.h"
5    
6  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
8        SUBROUTINE MNC_FILE_CREATE(        SUBROUTINE MNC_FILE_CREATE(
9       I     myThid,       I     myThid,
# Line 15  C     Arguments Line 15  C     Arguments
15        integer myThid        integer myThid
16        character*(*) fname        character*(*) fname
17    
18        CALL MNC_FILE_OPEN(myThid, fname, 0)  C     Local Variables
19          integer indf
20    
21          CALL MNC_FILE_OPEN(myThid, fname, 0, indf)
22    
23        RETURN        RETURN
24        END        END
25    
26  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
27    
28        SUBROUTINE MNC_FILE_OPEN(        SUBROUTINE MNC_FILE_OPEN(
29       I     myThid,       I     myThid,
30       I     fname,       I     fname,
31       I     itype )       I     itype,
32         O     indf )
33    
34        implicit none        implicit none
35  #include "netcdf.inc"  #include "netcdf.inc"
# Line 33  C======================================= Line 37  C=======================================
37  #include "EEPARAMS.h"  #include "EEPARAMS.h"
38    
39  C     Arguments  C     Arguments
40        integer myThid        integer myThid,indf
41        character*(*) fname        character*(*) fname
42        integer itype        integer itype
43  C     itype => [ 0=new | 1=append ]  C     itype => [ 0=new | 1=append ]
# Line 42  C     Functions Line 46  C     Functions
46        integer ILNBLNK        integer ILNBLNK
47    
48  C     Local Variables  C     Local Variables
49        integer i,n, err, fid, ind        integer n, err, fid
       character*(MNC_MAX_CHAR) aname  
50        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
51    
52  C     Is the file already open?  C     Is the file already open?
53        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
54        IF ( ind .GT. 0 ) THEN        IF (indf .GT. 0) THEN
55          write(msgbuf,'(3a)') 'MNC_FILE_OPEN ERROR: ''', fname,          write(msgbuf,'(3a)') 'MNC_FILE_OPEN ERROR: ''', fname,
56       &       ''' is already open -- cannot open twice'       &       ''' is already open -- cannot open twice'
57          CALL print_error( msgbuf, mythid )          CALL print_error(msgbuf, mythid)
58          stop 'ABNORMAL END: package MNC'          stop 'ABNORMAL END: package MNC'
59        ENDIF        ENDIF
60    
61        write(msgbuf,'(3a)') 'opening ''', fname, ''''        write(msgbuf,'(3a)') 'opening ''', fname, ''''
62        IF ( itype .EQ. 0 ) THEN        IF (itype .EQ. 0) THEN
63    
64  C       Create new file  C       Create new file
65          err = NF_CREATE( fname, NF_CLOBBER, fid )          err = NF_CREATE(fname, NF_CLOBBER, fid)
66          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
67        ELSEIF ( itype .EQ. 1 ) THEN  
68          ELSEIF (itype .EQ. 1) THEN
69    
70  C       Append to existing file  C       Append to existing file
71          err = NF_OPEN( fname, NF_WRITE, fid )          CALL MNC_FILE_READALL(myThid, fname)
72          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)  
73        ELSE        ELSE
74  C       Error  C       Error
75          write(msgbuf,'(a,i5,a)') 'MNC_FILE_OPEN ERROR: ''', itype,          write(msgbuf,'(a,i5,a)') 'MNC_FILE_OPEN ERROR: ''', itype,
# Line 72  C       Error Line 78  C       Error
78          stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_STR'          stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_STR'
79        ENDIF        ENDIF
80    
81        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_f_names, ind)        CALL MNC_GET_NEXT_EMPTY_IND(myThid,MNC_MAX_ID,mnc_f_names,indf)
82        n = ILNBLNK(fname)        n = ILNBLNK(fname)
83        mnc_f_names(ind)(1:n) = fname(1:n)        mnc_f_names(indf)(1:n) = fname(1:n)
84        mnc_f_info(ind,1) = 1        mnc_f_info(indf,1) = 1
85        mnc_f_info(ind,2) = fid        mnc_f_info(indf,2) = fid
86        mnc_f_info(ind,3) = 0        mnc_f_info(indf,3) = 0
87        mnc_fv_ids(ind,1) = 0        mnc_fv_ids(indf,1) = 0
88          mnc_f_alld(indf,1) = 0
89    
90        RETURN        RETURN
91        END        END
92    
93  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
94    
95        SUBROUTINE MNC_FILE_ADD_ATTR_STR(        SUBROUTINE MNC_FILE_ADD_ATTR_STR(
96       I     myThid,       I     myThid,
# Line 93  C======================================= Line 100  C=======================================
100    
101        implicit none        implicit none
102  C     Arguments  C     Arguments
103        integer myThid, len        integer myThid
104        character*(*) fname, atname, sval        character*(*) fname, atname, sval
105    
106        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 1,        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 1,
# Line 101  C     Arguments Line 108  C     Arguments
108        RETURN        RETURN
109        END        END
110    
111  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
112    
113        SUBROUTINE MNC_FILE_ADD_ATTR_DBL(        SUBROUTINE MNC_FILE_ADD_ATTR_DBL(
114       I     myThid,       I     myThid,
# Line 114  C======================================= Line 121  C=======================================
121  C     Arguments  C     Arguments
122        integer myThid, len        integer myThid, len
123        character*(*) fname, atname        character*(*) fname, atname
124        _RL dval        REAL*8 dval
125    
126        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 2,        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 2,
127       &     ' ', len, dval, 0.0, 0 )       &     ' ', len, dval, 0.0, 0 )
128        RETURN        RETURN
129        END        END
130    
131  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
132    
133        SUBROUTINE MNC_FILE_ADD_ATTR_REAL(        SUBROUTINE MNC_FILE_ADD_ATTR_REAL(
134       I     myThid,       I     myThid,
# Line 134  C======================================= Line 141  C=======================================
141  C     Arguments  C     Arguments
142        integer myThid, len        integer myThid, len
143        character*(*) fname, atname        character*(*) fname, atname
144        _RS rval        REAL*4 rval
145    
146        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 3,        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 3,
147       &     ' ', len, 0.0D0, rval, 0 )       &     ' ', len, 0.0D0, rval, 0 )
148        RETURN        RETURN
149        END        END
150    
151  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
152    
153        SUBROUTINE MNC_FILE_ADD_ATTR_INT(        SUBROUTINE MNC_FILE_ADD_ATTR_INT(
154       I     myThid,       I     myThid,
# Line 160  C     Arguments Line 167  C     Arguments
167        RETURN        RETURN
168        END        END
169    
170  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
171    
172        SUBROUTINE MNC_FILE_ADD_ATTR_ANY(        SUBROUTINE MNC_FILE_ADD_ATTR_ANY(
173       I     myThid,       I     myThid,
# Line 176  C======================================= Line 183  C=======================================
183  C     Arguments  C     Arguments
184        integer myThid, atype, len, iv        integer myThid, atype, len, iv
185        character*(*) fname, atname, sv        character*(*) fname, atname, sv
186        _RL dv        REAL*8 dv
187        _RS rv        REAL*4 rv
188                
189  C     Functions  C     Functions
190        integer ILNBLNK        integer ILNBLNK
191    
192  C     Local Variables  C     Local Variables
193        integer i, n, err, fid, ind, n1,n2, lens        integer n, err, fid, ind, n1, lens
194        character*(MNC_MAX_CHAR) s1        character*(MNC_MAX_CHAR) s1
195        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
196                
# Line 207  C     Enter define mode Line 214  C     Enter define mode
214        IF (atype .EQ. 1) THEN        IF (atype .EQ. 1) THEN
215          lens = ILNBLNK(sv)          lens = ILNBLNK(sv)
216          err = NF_PUT_ATT_TEXT(fid, NF_GLOBAL, s1, lens, sv)          err = NF_PUT_ATT_TEXT(fid, NF_GLOBAL, s1, lens, sv)
217            CALL MNC_HANDLE_ERR(myThid, err,
218         &       'adding TEXT attribute in S/R MNC_FILE_ADD_ATTR_ANY')
219        ELSEIF (atype .EQ. 2) THEN        ELSEIF (atype .EQ. 2) THEN
220          err = NF_PUT_ATT_DOUBLE(fid, NF_GLOBAL, s1, NF_DOUBLE, len, dv)          err = NF_PUT_ATT_DOUBLE(fid, NF_GLOBAL, s1, NF_DOUBLE, len, dv)
221            CALL MNC_HANDLE_ERR(myThid, err,
222         &       'adding DOUBLE attribute in S/R MNC_FILE_ADD_ATTR_ANY')
223        ELSEIF (atype .EQ. 3) THEN        ELSEIF (atype .EQ. 3) THEN
224          err = NF_PUT_ATT_REAL(fid, NF_GLOBAL, s1, NF_FLOAT, len, rv)          err = NF_PUT_ATT_REAL(fid, NF_GLOBAL, s1, NF_FLOAT, len, rv)
225            CALL MNC_HANDLE_ERR(myThid, err,
226         &       'adding REAL attribute in S/R MNC_FILE_ADD_ATTR_ANY')
227        ELSEIF (atype .EQ. 4) THEN        ELSEIF (atype .EQ. 4) THEN
228          err = NF_PUT_ATT_INT(fid, NF_GLOBAL, s1, NF_INT, len, iv)          err = NF_PUT_ATT_INT(fid, NF_GLOBAL, s1, NF_INT, len, iv)
229            CALL MNC_HANDLE_ERR(myThid, err,
230         &       'adding INT attribute in S/R MNC_FILE_ADD_ATTR_ANY')
231        ELSE        ELSE
232          write(msgbuf,'(a,i10,a)') 'MNC ERROR: atype = ''', atype,          write(msgbuf,'(a,i10,a)') 'MNC ERROR: atype = ''', atype,
233       &       ''' is invalid--must be: [1-4]'       &       ''' is invalid--must be: [1-4]'
# Line 220  C     Enter define mode Line 235  C     Enter define mode
235          CALL print_error(msgbuf(1:n), mythid)          CALL print_error(msgbuf(1:n), mythid)
236          stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_ANY'          stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_ANY'
237        ENDIF        ENDIF
       CALL MNC_HANDLE_ERR(myThid, err,  
      &     'adding attribute in S/R MNC_FILE_ADD_ATTR_DBL')  
238    
239        RETURN        RETURN
240        END        END
241    
242  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
243    
244        SUBROUTINE MNC_FILE_CLOSE(        SUBROUTINE MNC_FILE_CLOSE(
245       I     myThid,       I     myThid,
# Line 258  C     Check that the file is open Line 271  C     Check that the file is open
271        write(msgbuf,'(3a)') ' cannot close file ''', fname, ''''        write(msgbuf,'(3a)') ' cannot close file ''', fname, ''''
272        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
273    
274  C     Clear all the file, grid, and variable names and refs  C     Clear all the info associated with this file
275    C     variables
276        n = mnc_fv_ids(ind,1)        n = mnc_fv_ids(ind,1)
277        IF (n .GE. 1) THEN        IF (n .GE. 1) THEN
278          DO i = 1,n          DO i = 1,n
279            j = 2*i            j = 2 + 3*(i - 1)
280            k = mnc_fv_ids(ind,j)            k = mnc_fv_ids(ind,j)
281            mnc_v_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)            mnc_v_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
282          ENDDO          ENDDO
283            DO i = 1,(1 + 3*n)
284              mnc_fv_ids(ind,i) = 0
285            ENDDO
286        ENDIF        ENDIF
287        DO i = 1,3  C     dims
288          mnc_f_info(ind,i) = 0        n = mnc_f_alld(ind,1)
289          mnc_f_alld(ind,1) = 0
290          DO i = 1,n
291            j = mnc_f_alld(ind,i+1)
292            mnc_d_ids(j)  = 0
293            mnc_d_size(j) = 0
294            mnc_d_names(j)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
295            mnc_f_alld(ind,i+1) = 0
296        ENDDO        ENDDO
297    C     grids
298          n = mnc_f_info(ind,3)
299          IF (n .GT. 0) THEN
300            DO i = 1,n
301              j = 4 + 3*(i - 1)
302              k = mnc_f_info(ind,j)
303              mnc_g_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
304            ENDDO
305            DO i = 1,MNC_MAX_INFO
306              mnc_fd_ind(ind,i) = 0
307              mnc_f_info(ind,i) = 0
308            ENDDO
309          ENDIF
310    C     file name
311        mnc_f_names(ind)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)        mnc_f_names(ind)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
312    
313        RETURN        RETURN
314        END        END
315    
316  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
317    
318          SUBROUTINE MNC_FILE_CLOSE_ALL_MATCHING(
319         I     myThid,
320         I     fname )
321    
322          implicit none
323    #include "netcdf.inc"
324    #include "mnc_common.h"
325    #include "EEPARAMS.h"
326    
327    C     Arguments
328          integer myThid
329          character*(*) fname
330    
331    C     Functions
332          integer ILNBLNK
333    
334    C     Local Variables
335          integer i,n
336    
337          n = ILNBLNK(fname)
338          DO i = 1,MNC_MAX_ID
339    
340    C       Check that the file is open
341            IF (fname(1:n) .EQ. mnc_f_names(i)(1:n)) THEN
342              CALL MNC_FILE_CLOSE(myThid,mnc_f_names(i))
343            ENDIF
344    
345          ENDDO
346    
347          RETURN
348          END
349    
350    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
351    
352          SUBROUTINE MNC_FILE_CLOSE_ALL(
353         I     myThid )
354    
355          implicit none
356    #include "netcdf.inc"
357    #include "mnc_common.h"
358    #include "EEPARAMS.h"
359    
360    C     Arguments
361          integer myThid
362    
363    C     Local Variables
364          integer i
365    
366          DO i = 1,MNC_MAX_ID
367    
368    C       Check that the file is open
369            IF (mnc_f_names(i)(1:MNC_MAX_CHAR)
370         &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
371              CALL MNC_FILE_CLOSE(myThid,mnc_f_names(i))
372            ENDIF
373    
374          ENDDO
375    
376          RETURN
377          END
378    
379    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
380    
381        SUBROUTINE MNC_FILE_REDEF(        SUBROUTINE MNC_FILE_REDEF(
382       I     myThid,       I     myThid,
# Line 294  C     Functions Line 395  C     Functions
395        integer ILNBLNK        integer ILNBLNK
396    
397  C     Local Variables  C     Local Variables
398        integer ind, fid, def, err        integer ind, fid, def, err, n
399        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
400    
401  C     Verify that the file is open  C     Verify that the file is open
402        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
403        IF (ind .LT. 0) THEN        IF (ind .LT. 0) THEN
404            n = ILNBLNK(fname)
405          write(msgbuf,'(3a)') 'MNC ERROR: file ''',          write(msgbuf,'(3a)') 'MNC ERROR: file ''',
406       &       fname, ''' must be opened first'       &       fname(1:n), ''' must be opened first'
407          CALL print_error( msgbuf, mythid )          CALL print_error( msgbuf, mythid )
408          stop 'ABNORMAL END: S/R MNC_FILE_REDEF'          stop 'ABNORMAL END: S/R MNC_FILE_REDEF'
409        ENDIF        ENDIF
# Line 319  C       Enter define mode Line 421  C       Enter define mode
421        RETURN        RETURN
422        END        END
423    
424  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
425    
426        SUBROUTINE MNC_FILE_ENDDEF(        SUBROUTINE MNC_FILE_ENDDEF(
427       I     myThid,       I     myThid,
# Line 338  C     Functions Line 440  C     Functions
440        integer ILNBLNK        integer ILNBLNK
441    
442  C     Local Variables  C     Local Variables
443        integer ind, fid, def, err        integer ind, fid, def, err, n
444        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
445    
446  C     Verify that the file is open  C     Verify that the file is open
447        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
448        IF (ind .LT. 0) THEN        IF (ind .LT. 0) THEN
449            n = ILNBLNK(fname)
450          write(msgbuf,'(3a)') 'MNC ERROR: file ''',          write(msgbuf,'(3a)') 'MNC ERROR: file ''',
451       &       fname, ''' must be opened first'       &       fname(1:n), ''' must be opened first'
452          CALL print_error( msgbuf, mythid )          CALL print_error( msgbuf, mythid )
453          stop 'ABNORMAL END: S/R MNC_FILE_REDEF'          stop 'ABNORMAL END: S/R MNC_FILE_REDEF'
454        ENDIF        ENDIF
# Line 362  C       Enter define mode Line 465  C       Enter define mode
465    
466        RETURN        RETURN
467        END        END
468    
469    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
470    
471          SUBROUTINE MNC_FILE_READALL(
472         I     myThid,
473         I     fname )
474    
475          implicit none
476    #include "netcdf.inc"
477    #include "EEPARAMS.h"
478    
479    C     Arguments
480          integer myThid
481          character*(*) fname
482    
483    C     Functions
484          integer IFNBLNK, ILNBLNK
485    
486    C     Local Variables
487          integer ierr, nff,nlf, indf
488          character*(MAX_LEN_MBUF) msgbuf
489    
490          nff = IFNBLNK(fname)
491          nlf = ILNBLNK(fname)
492          CALL MNC_FILE_TRY_READ(myThid, fname, ierr, indf)
493          write(msgbuf,'(3a)') 'MNC ERROR: cannot open file ''',
494         &     fname(nff:nlf), ''' for read/write access'
495          CALL MNC_HANDLE_ERR(myThid, ierr, msgbuf)
496    
497          RETURN
498          END
499    
500    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
501    
502          SUBROUTINE MNC_FILE_TRY_READ(
503         I     myThid,
504         I     fname,
505         O     ierr,
506         O     indf )
507    
508          implicit none
509    #include "netcdf.inc"
510    #include "mnc_common.h"
511    #include "EEPARAMS.h"
512    
513    C     Arguments
514          integer myThid, ierr, indf
515          character*(*) fname
516    
517    C     Functions
518          integer IFNBLNK, ILNBLNK
519    
520    C     Local Variables
521          integer i,j,k, fid, err, ndim,nvar,ngat,unlimid
522          integer dlen, id, xtype, nat, nff,nlf, iv
523          integer ndv, did, ns,ne, n1,n2, indg, indv
524          character*(MAX_LEN_MBUF) msgbuf
525          character*(NF_MAX_NAME) name
526          integer idlist(NF_MAX_VAR_DIMS)
527          character*(MNC_MAX_CHAR) dnames(20)
528    
529    C     Open and save the filename and fID
530          nff = IFNBLNK(fname)
531          nlf = ILNBLNK(fname)
532          err = NF_OPEN(fname, NF_WRITE, fid)
533          ierr = NF_NOERR
534          IF (err .NE. NF_NOERR) THEN
535            ierr = err
536            RETURN
537          ENDIF
538          CALL MNC_GET_NEXT_EMPTY_IND(myThid,MNC_MAX_ID,mnc_f_names,indf)
539          mnc_f_names(indf)(1:(nlf-nff+1)) = fname(nff:nlf)
540          mnc_f_info(indf,2) = fid
541    
542    C     Get the overall number of entities
543          err = NF_INQ(fid, ndim, nvar, ngat, unlimid)
544          write(msgbuf,'(4a)') 'MNC ERROR: cannot read number of dims',
545         &     ' in file ''', fname(nff:nlf), ''''
546          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
547    
548    C     Read each dimension and save the information
549          DO id = 1,ndim
550            err = NF_INQ_DIM(fid, id, name, dlen)
551            write(msgbuf,'(2a,i5,3a)') 'MNC ERROR: cannot read dimension',
552         &       ' info for dim ''', id, ''' in file ''',
553         &       fname(nff:nlf), ''''
554            CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
555            IF (id .EQ. unlimid) THEN
556              dlen = -1
557            ENDIF
558            ns = IFNBLNK(name)
559            ne = ILNBLNK(name)
560            CALL MNC_DIM_INIT_ALL(myThid,fname,name(ns:ne),dlen,'N')
561            DO i = 1,mnc_f_alld(indf,1)
562              j = mnc_f_alld(indf,i+1)
563              n1 = IFNBLNK(mnc_d_names(j))
564              n2 = ILNBLNK(mnc_d_names(j))
565              IF (((ne-ns) .EQ. (n2-n1))
566         &         .AND. (mnc_d_names(j)(ns:ne) .EQ. name(ns:ne))) THEN
567                mnc_d_ids(j) = id
568                goto 10
569              ENDIF
570            ENDDO
571     10     CONTINUE
572          ENDDO
573    
574    C     Read and save each variable
575          DO id = 1,nvar
576            err = NF_INQ_VAR(fid, id, name, xtype, ndv, idlist, nat)
577            write(msgbuf,'(2a,i5,3a)') 'MNC ERROR: cannot read variable',
578         &       ' info for variable ''', id, ''' in file ''',
579         &       fname(nff:nlf), ''''
580            CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
581            n1 = IFNBLNK(name)
582            n2 = ILNBLNK(name)
583            
584    C       Create a grid for this variable
585            DO i = 1,ndv
586              did = idlist(i)
587              dnames(i)(1:MNC_MAX_CHAR) = mnc_d_names(did)(1:MNC_MAX_CHAR)
588            ENDDO
589            CALL MNC_GRID_INIT_ALL(myThid, fname, name, ndv, dnames, indg)
590    
591    C       Update the tables
592            CALL MNC_GET_NEXT_EMPTY_IND(myThid,MNC_MAX_ID,mnc_v_names,indv)
593            mnc_v_names(indv)(1:(n2-n1+1)) = name(n1:n2)
594            iv = 2 + 3*mnc_fv_ids(indf,1)
595            mnc_fv_ids(indf,iv)   = indv
596            mnc_fv_ids(indf,iv+1) = id
597            DO i = 1,mnc_f_info(indf,3)
598              j = 4 + 3*(i-1)
599              k = mnc_f_info(indf,j)
600              IF (k .EQ. indg) THEN
601                mnc_fv_ids(indf,iv+2) = j
602                GOTO 20
603              ENDIF
604            ENDDO
605     20     CONTINUE
606            mnc_fv_ids(indf,1) = mnc_fv_ids(indf,1) + 1
607            
608          ENDDO
609    
610          RETURN
611          END
612    
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22