/[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.2 by edhill, Mon Jan 5 21:38:27 2004 UTC revision 1.3 by edhill, Tue Jan 6 23:19:27 2004 UTC
# Line 5  C $Name$ Line 5  C $Name$
5    
6  C==================================================================  C==================================================================
7    
8          SUBROUTINE MNC_FILE_CREATE(
9         I     myThid,
10         I     fname )
11    
12          implicit none
13    
14    C     Arguments
15          integer myThid
16          character*(*) fname
17    
18          CALL MNC_FILE_OPEN(myThid, fname, 0)
19    
20          RETURN
21          END
22    
23    C==================================================================
24    
25        SUBROUTINE MNC_FILE_OPEN(        SUBROUTINE MNC_FILE_OPEN(
26       I     myThid,       I     myThid,
27       I     fname,       I     fname,
# Line 21  C     Arguments Line 38  C     Arguments
38        integer itype        integer itype
39  C     itype => [ 0=new | 1=append ]  C     itype => [ 0=new | 1=append ]
40    
41    C     Functions
42          integer ILNBLNK
43    
44  C     Local Variables  C     Local Variables
45        integer i, err, fid, ind        integer i,n, err, fid, ind
46        character*(MNC_MAX_CHAR) aname        character*(MNC_MAX_CHAR) aname
47        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
48    
# Line 35  C     Is the file already open? Line 55  C     Is the file already open?
55          stop 'ABNORMAL END: package MNC'          stop 'ABNORMAL END: package MNC'
56        ENDIF        ENDIF
57    
58          write(msgbuf,'(3a)') 'opening ''', fname, ''''
59        IF ( itype .EQ. 0 ) THEN        IF ( itype .EQ. 0 ) THEN
60  C       Create new file  C       Create new file
61          err = NF_CREATE( fname, NF_CLOBBER, fid )          err = NF_CREATE( fname, NF_CLOBBER, fid )
62          IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
63        ELSEIF ( itype .EQ. 1 ) THEN        ELSEIF ( itype .EQ. 1 ) THEN
64  C       Append to existing file  C       Append to existing file
65          err = NF_OPEN( fname, NF_WRITE, fid )          err = NF_OPEN( fname, NF_WRITE, fid )
66          IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
67        ELSE        ELSE
68  C       Error  C       Error
69          write(msgbuf,'(a,i5,a)') 'MNC_FILE_OPEN ERROR: ''', itype,          write(msgbuf,'(a,i5,a)') 'MNC_FILE_OPEN ERROR: ''', itype,
70       &       ''' is not defined--should be: [0|1]'       &       ''' is not defined--should be: [0|1]'
71            CALL print_error( msgbuf, mythid )
72            stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_STR'
73        ENDIF        ENDIF
74    
75        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, ind)
76        mnc_f_names(ind) = fname        n = ILNBLNK(fname)
77          mnc_f_names(ind)(1:n) = fname(1:n)
78        mnc_f_info(ind,1) = 1        mnc_f_info(ind,1) = 1
79        mnc_f_info(ind,1) = fid        mnc_f_info(ind,2) = fid
80          mnc_f_info(ind,3) = 0
81          mnc_fv_ids(ind,1) = 0
82    
83          RETURN
84        END        END
85    
86  C==================================================================  C==================================================================
# Line 95  C     Is the file open? Line 122  C     Is the file open?
122    
123  C     Enter define mode  C     Enter define mode
124        err = NF_REDEF(fid)        err = NF_REDEF(fid)
125        IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)        CALL MNC_HANDLE_ERR(myThid, err,
126         &     'redefining in S/R MNC_FILE_ADD_ATTR_STR')
127    
128        s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)        s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
129        s2(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)        s2(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
# Line 105  C     Enter define mode Line 133  C     Enter define mode
133        s2(1:n2) = sval(1:n2)        s2(1:n2) = sval(1:n2)
134    
135        err = NF_PUT_ATT_TEXT(fid, NF_GLOBAL, s1, n2, s2)        err = NF_PUT_ATT_TEXT(fid, NF_GLOBAL, s1, n2, s2)
136        IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)        CALL MNC_HANDLE_ERR(myThid, err,
137         &     'adding attribute in S/R MNC_FILE_ADD_ATTR_STR')
138    
139          RETURN
140        END        END
141    
142  C==================================================================  C==================================================================
# Line 147  C     Is the file open? Line 177  C     Is the file open?
177    
178  C     Enter define mode  C     Enter define mode
179        err = NF_REDEF(fid)        err = NF_REDEF(fid)
180        IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)        CALL MNC_HANDLE_ERR(myThid, err,
181         &     'redefining in S/R MNC_FILE_ADD_ATTR_INT')
182    
183        s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)        s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
184        n1 = ILNBLNK(atname)        n1 = ILNBLNK(atname)
185        s1(1:n1) = atname(1:n1)        s1(1:n1) = atname(1:n1)
186    
187        err = NF_PUT_ATT_INT(fid, NF_GLOBAL, s1, NF_INT, ival)        err = NF_PUT_ATT_INT(fid, NF_GLOBAL, s1, NF_INT, ival)
188        IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)        CALL MNC_HANDLE_ERR(myThid, err,
189         &     'adding attribute in S/R MNC_FILE_ADD_ATTR_INT')
190    
191          RETURN
192        END        END
193    
194  C==================================================================  C==================================================================
# Line 186  C     Local Variables Line 219  C     Local Variables
219    
220  C     Is the file open?  C     Is the file open?
221        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)
222        IF ( ind .GT. 0 ) THEN        IF (ind .GT. 0) THEN
223          write(msgbuf,'(3a)') 'MNC ERROR: file ''',          write(msgbuf,'(3a)') 'MNC ERROR: file ''',
224       &       fname, ''' must be opened first'       &       fname, ''' must be opened first'
225          CALL print_error( msgbuf, mythid )          CALL print_error( msgbuf, mythid )
# Line 196  C     Is the file open? Line 229  C     Is the file open?
229    
230  C     Enter define mode  C     Enter define mode
231        err = NF_REDEF(fid)        err = NF_REDEF(fid)
232        IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)        CALL MNC_HANDLE_ERR(myThid, err,
233         &     'redefining in S/R MNC_FILE_ADD_ATTR_DBL')
234    
235        s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)        s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
236        n1 = ILNBLNK(atname)        n1 = ILNBLNK(atname)
237        s1(1:n1) = atname(1:n1)        s1(1:n1) = atname(1:n1)
238    
239        err = NF_PUT_ATT_DOUBLE(fid, NF_GLOBAL, s1, NF_DOUBLE, ival)        err = NF_PUT_ATT_DOUBLE(fid, NF_GLOBAL, s1, NF_DOUBLE, ival)
240        IF (err .NE. NF_NOERR) CALL MNC_HANDLE_ERR(myThid, err)        CALL MNC_HANDLE_ERR(myThid, err,
241         &     'adding attribute in S/R MNC_FILE_ADD_ATTR_DBL')
242    
243          RETURN
244          END
245    
246    C==================================================================
247    
248          SUBROUTINE MNC_FILE_CLOSE(
249         I     myThid,
250         I     fname )
251    
252          implicit none
253    #include "netcdf.inc"
254    #include "mnc_common.h"
255    #include "EEPARAMS.h"
256    
257    C     Arguments
258          integer myThid
259          character*(*) fname
260    
261    C     Local Variables
262          integer i,j,k,n, err, fid, ind
263          character*(MAX_LEN_MBUF) msgbuf
264    
265    C     Check that the file is open
266          CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
267          IF (ind .LT. 1) THEN
268            write(msgbuf,'(3a)') 'MNC Warning: file ''', fname,
269         &       ''' is already closed'
270            CALL print_error( msgbuf, mythid )
271            RETURN
272          ENDIF
273          fid = mnc_f_info(ind,2)
274          err = NF_CLOSE(fid)
275          write(msgbuf,'(3a)') ' cannot close file ''', fname, ''''
276          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
277    
278    C     Clear all the file, grid, and variable names and refs
279          n = mnc_fv_ids(ind,1)
280          IF (n .GE. 1) THEN
281            DO i = 1,n
282              j = 2*i
283              k = mnc_fv_ids(ind,j)
284              mnc_v_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
285              mnc_v_units(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
286            ENDDO
287          ENDIF
288          DO i = 1,3
289            mnc_f_info(ind,i) = 0
290          ENDDO
291          mnc_f_names(ind)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
292    
293          RETURN
294        END        END
295    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22