/[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.6 by edhill, Wed Jan 14 23:02:52 2004 UTC revision 1.7 by edhill, Sat Jan 17 13:55:49 2004 UTC
# Line 42  C     Functions Line 42  C     Functions
42        integer ILNBLNK        integer ILNBLNK
43    
44  C     Local Variables  C     Local Variables
45        integer i,n, err, fid, ind        integer n, err, fid, ind
       character*(MNC_MAX_CHAR) aname  
46        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
47    
48  C     Is the file already open?  C     Is the file already open?
# Line 79  C       Error Line 78  C       Error
78        mnc_f_info(ind,2) = fid        mnc_f_info(ind,2) = fid
79        mnc_f_info(ind,3) = 0        mnc_f_info(ind,3) = 0
80        mnc_fv_ids(ind,1) = 0        mnc_fv_ids(ind,1) = 0
81          mnc_f_alld(ind,1) = 0
82    
83        RETURN        RETURN
84        END        END
# Line 93  C======================================= Line 93  C=======================================
93    
94        implicit none        implicit none
95  C     Arguments  C     Arguments
96        integer myThid, len        integer myThid
97        character*(*) fname, atname, sval        character*(*) fname, atname, sval
98    
99        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 1,        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 1,
# Line 114  C======================================= Line 114  C=======================================
114  C     Arguments  C     Arguments
115        integer myThid, len        integer myThid, len
116        character*(*) fname, atname        character*(*) fname, atname
117        _RL dval        REAL*8 dval
118    
119        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 2,        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 2,
120       &     ' ', len, dval, 0.0, 0 )       &     ' ', len, dval, 0.0, 0 )
# Line 134  C======================================= Line 134  C=======================================
134  C     Arguments  C     Arguments
135        integer myThid, len        integer myThid, len
136        character*(*) fname, atname        character*(*) fname, atname
137        _RS rval        REAL*4 rval
138    
139        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 3,        CALL MNC_FILE_ADD_ATTR_ANY(myThid,fname,atname, 3,
140       &     ' ', len, 0.0D0, rval, 0 )       &     ' ', len, 0.0D0, rval, 0 )
# Line 176  C======================================= Line 176  C=======================================
176  C     Arguments  C     Arguments
177        integer myThid, atype, len, iv        integer myThid, atype, len, iv
178        character*(*) fname, atname, sv        character*(*) fname, atname, sv
179        _RL dv        REAL*8 dv
180        _RS rv        REAL*4 rv
181                
182  C     Functions  C     Functions
183        integer ILNBLNK        integer ILNBLNK
184    
185  C     Local Variables  C     Local Variables
186        integer i, n, err, fid, ind, n1,n2, lens        integer n, err, fid, ind, n1, lens
187        character*(MNC_MAX_CHAR) s1        character*(MNC_MAX_CHAR) s1
188        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
189                
# Line 264  C     Check that the file is open Line 264  C     Check that the file is open
264        write(msgbuf,'(3a)') ' cannot close file ''', fname, ''''        write(msgbuf,'(3a)') ' cannot close file ''', fname, ''''
265        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
266    
267  C     Clear all the file, grid, and variable names and refs  C     Clear all the file, grid, variable, and dim names and refs
268        n = mnc_fv_ids(ind,1)        n = mnc_fv_ids(ind,1)
269        IF (n .GE. 1) THEN        IF (n .GE. 1) THEN
270          DO i = 1,n          DO i = 1,n
# Line 273  C     Clear all the file, grid, and vari Line 273  C     Clear all the file, grid, and vari
273            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)
274          ENDDO          ENDDO
275        ENDIF        ENDIF
276          n = mnc_f_alld(ind,1)
277          DO i = 1,n
278            j = mnc_f_alld(ind,i+1)
279            mnc_d_names(j)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
280          ENDDO
281          mnc_f_alld(ind,1) = 0
282        DO i = 1,3        DO i = 1,3
283          mnc_f_info(ind,i) = 0          mnc_f_info(ind,i) = 0
284        ENDDO        ENDDO
# Line 300  C     Functions Line 306  C     Functions
306        integer ILNBLNK        integer ILNBLNK
307    
308  C     Local Variables  C     Local Variables
309        integer ind, fid, def, err        integer ind, fid, def, err, n
310        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
311    
312  C     Verify that the file is open  C     Verify that the file is open
313        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)
314        IF (ind .LT. 0) THEN        IF (ind .LT. 0) THEN
315            n = ILNBLNK(fname)
316          write(msgbuf,'(3a)') 'MNC ERROR: file ''',          write(msgbuf,'(3a)') 'MNC ERROR: file ''',
317       &       fname, ''' must be opened first'       &       fname(1:n), ''' must be opened first'
318          CALL print_error( msgbuf, mythid )          CALL print_error( msgbuf, mythid )
319          stop 'ABNORMAL END: S/R MNC_FILE_REDEF'          stop 'ABNORMAL END: S/R MNC_FILE_REDEF'
320        ENDIF        ENDIF
# Line 344  C     Functions Line 351  C     Functions
351        integer ILNBLNK        integer ILNBLNK
352    
353  C     Local Variables  C     Local Variables
354        integer ind, fid, def, err        integer ind, fid, def, err, n
355        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
356    
357  C     Verify that the file is open  C     Verify that the file is open
358        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)
359        IF (ind .LT. 0) THEN        IF (ind .LT. 0) THEN
360            n = ILNBLNK(fname)
361          write(msgbuf,'(3a)') 'MNC ERROR: file ''',          write(msgbuf,'(3a)') 'MNC ERROR: file ''',
362       &       fname, ''' must be opened first'       &       fname(1:n), ''' must be opened first'
363          CALL print_error( msgbuf, mythid )          CALL print_error( msgbuf, mythid )
364          stop 'ABNORMAL END: S/R MNC_FILE_REDEF'          stop 'ABNORMAL END: S/R MNC_FILE_REDEF'
365        ENDIF        ENDIF
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22