/[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.8 by edhill, Sun Jan 18 23:23:15 2004 UTC revision 1.9 by edhill, Sun Jan 25 00:22:57 2004 UTC
# Line 56  C     Is the file already open? Line 56  C     Is the file already open?
56    
57        write(msgbuf,'(3a)') 'opening ''', fname, ''''        write(msgbuf,'(3a)') 'opening ''', fname, ''''
58        IF ( itype .EQ. 0 ) THEN        IF ( itype .EQ. 0 ) THEN
59    
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          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
63    
64        ELSEIF ( itype .EQ. 1 ) THEN        ELSEIF ( itype .EQ. 1 ) THEN
65    
66  C       Append to existing file  C       Append to existing file
67          err = NF_OPEN( fname, NF_WRITE, fid )          CALL MNC_FILE_READALL(myThid, fname)
68          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)  
69        ELSE        ELSE
70  C       Error  C       Error
71          write(msgbuf,'(a,i5,a)') 'MNC_FILE_OPEN ERROR: ''', itype,          write(msgbuf,'(a,i5,a)') 'MNC_FILE_OPEN ERROR: ''', itype,
# Line 264  C     Check that the file is open Line 267  C     Check that the file is open
267        write(msgbuf,'(3a)') ' cannot close file ''', fname, ''''        write(msgbuf,'(3a)') ' cannot close file ''', fname, ''''
268        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
269    
270  C     Clear all the file, grid, variable, and dim names and refs  C     Clear all the info associated with this file
271    C     variables
272        n = mnc_fv_ids(ind,1)        n = mnc_fv_ids(ind,1)
273        IF (n .GE. 1) THEN        IF (n .GE. 1) THEN
274          DO i = 1,n          DO i = 1,n
275            j = 2*i            j = 2 + 3*(i - 1)
276            k = mnc_fv_ids(ind,j)            k = mnc_fv_ids(ind,j)
277            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)
278          ENDDO          ENDDO
279            DO i = 1,(1 + 3*n)
280              mnc_fv_ids(ind,i) = 0
281            ENDDO
282        ENDIF        ENDIF
283    C     dims
284        n = mnc_f_alld(ind,1)        n = mnc_f_alld(ind,1)
285          mnc_f_alld(ind,1) = 0
286        DO i = 1,n        DO i = 1,n
287          j = mnc_f_alld(ind,i+1)          j = mnc_f_alld(ind,i+1)
288            mnc_d_ids(j)  = 0
289            mnc_d_size(j) = 0
290          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)
291            mnc_f_alld(ind,i+1) = 0
292        ENDDO        ENDDO
293        mnc_f_alld(ind,1) = 0  C     grids
294        DO i = 1,3        n = mnc_f_info(ind,3)
295          mnc_f_info(ind,i) = 0        IF (n .GT. 0) THEN
296        ENDDO          DO i = 1,n
297              j = 4 + 3*(i - 1)
298              k = mnc_f_info(ind,j)
299              mnc_g_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
300            ENDDO
301            DO i = 1,MNC_MAX_INFO
302              mnc_fd_ind(ind,i) = 0
303              mnc_f_info(ind,i) = 0
304            ENDDO
305          ENDIF
306    C     file name
307        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)
308    
309        RETURN        RETURN
# Line 439  C       Enter define mode Line 461  C       Enter define mode
461    
462        RETURN        RETURN
463        END        END
464    
465    C==================================================================
466    
467          SUBROUTINE MNC_FILE_READALL(
468         I     myThid,
469         I     fname )
470    
471          implicit none
472    #include "netcdf.inc"
473    #include "mnc_common.h"
474    #include "EEPARAMS.h"
475    
476    C     Arguments
477          integer myThid
478          character*(*) fname
479    
480    C     Functions
481          integer IFNBLNK, ILNBLNK
482    
483    C     Local Variables
484          integer i,j,k, fid, err, ndim,nvar,ngat,unlimid
485          integer dlen, id, indf, xtype, nat, nff,nlf, iv
486          integer ndv, did, ns,ne, n1,n2, indg, indv
487          character*(MAX_LEN_MBUF) msgbuf
488          character*(NF_MAX_NAME) name
489          integer idlist(NF_MAX_VAR_DIMS)
490          character*(MNC_MAX_CHAR) dnames(20)
491    
492    C     Open and save the filename and fID
493          nff = IFNBLNK(fname)
494          nlf = ILNBLNK(fname)
495          err = NF_OPEN(fname, NF_WRITE, fid)
496          write(msgbuf,'(3a)') 'MNC ERROR: cannot open file ''',
497         &     fname(nff:nlf), ''' for read/write access'
498          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
499          CALL MNC_GET_NEXT_EMPTY_IND(myThid,MNC_MAX_ID,mnc_f_names,indf)
500          mnc_f_names(indf)(1:(nlf-nff+1)) = fname(nff:nlf)
501          mnc_f_info(indf,2) = fid
502    
503    C     Get the overall number of entities
504          err = NF_INQ(fid, ndim, nvar, ngat, unlimid)
505          write(msgbuf,'(4a)') 'MNC ERROR: cannot read number of dims',
506         &     ' in file ''', fname(nff:nlf), ''''
507          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
508    
509    C     Read each dimension and save the information
510          DO id = 1,ndim
511            err = NF_INQ_DIM(fid, id, name, dlen)
512            write(msgbuf,'(2a,i5,3a)') 'MNC ERROR: cannot read dimension',
513         &       ' info for dim ''', id, ''' in file ''',
514         &       fname(nff:nlf), ''''
515            CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
516            IF (id .EQ. unlimid) THEN
517              dlen = -1
518            ENDIF
519            ns = IFNBLNK(name)
520            ne = ILNBLNK(name)
521            CALL MNC_DIM_INIT_ALL(myThid,fname,name(ns:ne),dlen,'N')
522            DO i = 1,mnc_f_alld(indf,1)
523              j = mnc_f_alld(indf,i+1)
524              n1 = IFNBLNK(mnc_d_names(j))
525              n2 = ILNBLNK(mnc_d_names(j))
526              IF (((ne-ns) .EQ. (n2-n1))
527         &         .AND. (mnc_d_names(j)(ns:ne) .EQ. name(ns:ne))) THEN
528                mnc_d_ids(j) = id
529                goto 10
530              ENDIF
531            ENDDO
532     10     CONTINUE
533          ENDDO
534    
535    C     Read and save each variable
536          DO id = 1,nvar
537            err = NF_INQ_VAR(fid, id, name, xtype, ndv, idlist, nat)
538            write(msgbuf,'(2a,i5,3a)') 'MNC ERROR: cannot read variable',
539         &       ' info for variable ''', id, ''' in file ''',
540         &       fname(nff:nlf), ''''
541            CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
542            n1 = IFNBLNK(name)
543            n2 = ILNBLNK(name)
544            
545    C       Create a grid for this variable
546            DO i = 1,ndv
547              did = idlist(i)
548              dnames(i)(1:MNC_MAX_CHAR) = mnc_d_names(did)(1:MNC_MAX_CHAR)
549            ENDDO
550            CALL MNC_GRID_INIT_ALL(myThid, fname, name, ndv, dnames, indg)
551    
552    C       Update the tables
553            CALL MNC_GET_NEXT_EMPTY_IND(myThid,MNC_MAX_ID,mnc_v_names,indv)
554            mnc_v_names(indv)(1:(n2-n1+1)) = name(n1:n2)
555            iv = 2 + 3*mnc_fv_ids(indf,1)
556            mnc_fv_ids(indf,iv)   = indv
557            mnc_fv_ids(indf,iv+1) = id
558            DO i = 1,mnc_f_info(indf,3)
559              j = 4 + 3*(i-1)
560              k = mnc_f_info(indf,j)
561              IF (k .EQ. indg) THEN
562                mnc_fv_ids(indf,iv+2) = j
563                GOTO 20
564              ENDIF
565            ENDDO
566     20     CONTINUE
567            mnc_fv_ids(indf,1) = mnc_fv_ids(indf,1) + 1
568            
569          ENDDO
570    
571          RETURN
572          END
573    
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22