/[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.12 by edhill, Wed Feb 4 05:45:09 2004 UTC revision 1.13 by edhill, Mon Mar 8 21:15:49 2004 UTC
# Line 40  C     Arguments Line 40  C     Arguments
40        integer myThid,indf        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 | 2=read-only ]
44    
45  C     Functions  C     Functions
46        integer ILNBLNK        integer ILNBLNK
47    
48  C     Local Variables  C     Local Variables
49        integer n, err, fid        integer n, err, fid, nf
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          nf = ILNBLNK(fname)
54        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
55        IF (indf .GT. 0) THEN        IF (indf .GT. 0) THEN
56          write(msgbuf,'(3a)') 'MNC_FILE_OPEN ERROR: ''', fname,          write(msgbuf,'(3a)') 'MNC_FILE_OPEN ERROR: ''', fname(1:nf),
57       &       ''' is already open -- cannot open twice'       &       ''' is already open -- cannot open twice'
58          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
59          stop 'ABNORMAL END: package MNC'          stop 'ABNORMAL END: package MNC'
# Line 254  C     Arguments Line 255  C     Arguments
255        integer myThid        integer myThid
256        character*(*) fname        character*(*) fname
257    
258    C     Functions
259          integer ILNBLNK
260    
261  C     Local Variables  C     Local Variables
262        integer i,j,k,n, err, fid, ind        integer i,j,k,n, err, fid, indf, nf
263        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
264    
265          nf = ILNBLNK(fname)
266    
267  C     Check that the file is open  C     Check that the file is open
268        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)
269        IF (ind .LT. 1) THEN        IF (indf .LT. 1) THEN
270          write(msgbuf,'(3a)') 'MNC Warning: file ''', fname,          write(msgbuf,'(3a)') 'MNC Warning: file ''', fname(1:nf),
271       &       ''' is already closed'       &       ''' is already closed'
272          CALL print_error( msgbuf, mythid )          CALL print_error( msgbuf, mythid )
273          RETURN          RETURN
274        ENDIF        ENDIF
275        fid = mnc_f_info(ind,2)        fid = mnc_f_info(indf,2)
276        err = NF_CLOSE(fid)        err = NF_CLOSE(fid)
277        write(msgbuf,'(3a)') ' cannot close file ''', fname, ''''        write(msgbuf,'(3a)') ' cannot close file ''', fname(1:nf), ''''
278        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
279    
280  C     Clear all the info associated with this file  C     Clear all the info associated with this file
281  C     variables  C     variables
282        n = mnc_fv_ids(ind,1)        n = mnc_fv_ids(indf,1)
283        IF (n .GE. 1) THEN        IF (n .GE. 1) THEN
284          DO i = 1,n          DO i = 1,n
285            j = 2 + 3*(i - 1)            j = 2 + 3*(i - 1)
286            k = mnc_fv_ids(ind,j)            k = mnc_fv_ids(indf,j)
287            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)
288          ENDDO          ENDDO
289          DO i = 1,(1 + 3*n)          DO i = 1,MNC_MAX_INFO
290            mnc_fv_ids(ind,i) = 0            mnc_fv_ids(indf,i) = 0
291          ENDDO          ENDDO
292        ENDIF        ENDIF
293  C     dims  C     dims
294        n = mnc_f_alld(ind,1)        n = mnc_f_alld(indf,1)
295        mnc_f_alld(ind,1) = 0        mnc_f_alld(indf,1) = 0
296        DO i = 1,n        DO i = 1,n
297          j = mnc_f_alld(ind,i+1)          j = mnc_f_alld(indf,i+1)
298          mnc_d_ids(j)  = 0          mnc_d_ids(j)  = 0
299          mnc_d_size(j) = 0          mnc_d_size(j) = 0
300          mnc_d_names(j)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)          mnc_d_names(j)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
301          mnc_f_alld(ind,i+1) = 0          mnc_f_alld(indf,i+1) = 0
302        ENDDO        ENDDO
303  C     grids  C     grids
304        n = mnc_f_info(ind,3)        n = mnc_f_info(indf,3)
305        IF (n .GT. 0) THEN        IF (n .GT. 0) THEN
306          DO i = 1,n          DO i = 1,n
307            j = 4 + 3*(i - 1)            j = 4 + 3*(i - 1)
308            k = mnc_f_info(ind,j)            k = mnc_f_info(indf,j)
309            mnc_g_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)            mnc_g_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
310          ENDDO          ENDDO
311          DO i = 1,MNC_MAX_INFO          DO i = 1,MNC_MAX_INFO
312            mnc_fd_ind(ind,i) = 0            mnc_fd_ind(indf,i) = 0
313            mnc_f_info(ind,i) = 0            mnc_f_info(indf,i) = 0
314          ENDDO          ENDDO
315        ENDIF        ENDIF
316  C     file name  C     file name
317        mnc_f_names(ind)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)        mnc_f_names(indf)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
318    
319        RETURN        RETURN
320        END        END
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22