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

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

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

revision 1.5 by edhill, Wed Feb 4 05:45:09 2004 UTC revision 1.8 by edhill, Sun Mar 28 19:28:34 2004 UTC
# Line 5  C $Name$ Line 5  C $Name$
5                
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
8    CBOP
9    C     !ROUTINE: MNC_DIM_INIT
10    C     !INTERFACE:
11        SUBROUTINE MNC_DIM_INIT(        SUBROUTINE MNC_DIM_INIT(
      I     myThid,  
12       I     fname,       I     fname,
13       I     dname,       I     dname,
14       I     dlen )       I     dlen,
15         I     myThid )
16    
17    C     !DESCRIPTION:
18    C     Creates a NetCDF dimension within an existing NetCDF file
19    
20    C     !INPUT PARAMETERS:
21  C     Arguments  C     Arguments
22        integer myThid, dlen        integer myThid, dlen
23        character*(*) fname, dname        character*(*) fname, dname
24    CEOP
25    
26        CALL MNC_DIM_INIT_ALL(myThid, fname, dname, dlen, 'Y')        CALL MNC_DIM_INIT_ALL(fname, dname, dlen, 'Y', myThid)
27    
28        RETURN        RETURN
29        END        END
# Line 23  C     Arguments Line 31  C     Arguments
31    
32  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
33    
34    CBOP
35    C     !ROUTINE: MNC_DIM_INIT_ALL
36    C     !INTERFACE:
37        SUBROUTINE MNC_DIM_INIT_ALL(        SUBROUTINE MNC_DIM_INIT_ALL(
      I     myThid,  
38       I     fname,       I     fname,
39       I     dname,       I     dname,
40       I     dlen,       I     dlen,
41       I     doWrite )       I     doWrite,
42         I     myThid )
43    
44    C     !DESCRIPTION:
45    C     Creates a NetCDF dimension within an existing NetCDF file
46    
47    C     !USES:
48        implicit none        implicit none
49  #include "netcdf.inc"  #include "netcdf.inc"
50  #include "mnc_common.h"  #include "mnc_common.h"
51  #include "EEPARAMS.h"  #include "EEPARAMS.h"
52    
53  C     Arguments  C     !INPUT PARAMETERS:
54        integer myThid, dlen        integer myThid, dlen
55        character*(*) fname, dname        character*(*) fname, dname
56        character*(1) doWrite        character*(1) doWrite
# Line 43  C     Arguments Line 58  C     Arguments
58  C     Functions  C     Functions
59        integer ILNBLNK, IFNBLNK        integer ILNBLNK, IFNBLNK
60    
61  C     Local Variables  C     !LOCAL VARIABLES:
62        integer i,j, indf,indd, n,nf, dnf,dnl, ntmp, idd, err, tlen        integer i,j, indf,indd, n,nf, dnf,dnl, ntmp, idd, err, tlen
63        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
64    CEOP
65    
66        nf = ILNBLNK(fname)        nf = ILNBLNK(fname)
67    
# Line 53  C     Local Variables Line 69  C     Local Variables
69        dnl = ILNBLNK(dname)        dnl = ILNBLNK(dname)
70    
71  C     Verify that the file exists  C     Verify that the file exists
72        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)        CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
73        IF ( indf .LT. 1 ) THEN        IF ( indf .LT. 1 ) THEN
74          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
75       &       ''' does not exist'       &       ''' does not exist'
# Line 87  C           Its OK, the names and sizes Line 103  C           Its OK, the names and sizes
103          ENDIF          ENDIF
104        ENDDO        ENDDO
105    
106        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_d_names, indd)        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_d_names, indd, myThid)
107    
108  C     Create the dim within the file  C     Create the dim within the file
109        IF (doWrite(1:1) .EQ. 'Y') THEN        IF (doWrite(1:1) .EQ. 'Y') THEN
# Line 95  C     Create the dim within the file Line 111  C     Create the dim within the file
111          tlen = dlen          tlen = dlen
112          IF (dlen .LT. 1)  tlen = NF_UNLIMITED          IF (dlen .LT. 1)  tlen = NF_UNLIMITED
113    
114          CALL MNC_FILE_REDEF(myThid, fname)          CALL MNC_FILE_REDEF(fname, myThid)
115          err = NF_DEF_DIM(mnc_f_info(indf,2), dname(dnf:dnl), tlen, idd)          err = NF_DEF_DIM(mnc_f_info(indf,2), dname(dnf:dnl), tlen, idd)
116          write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',          write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',
117       &       'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)       &       'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)
118          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
119    
120        ENDIF        ENDIF
121    
# Line 113  C     Add to tables Line 129  C     Add to tables
129        RETURN        RETURN
130        END        END
131    
132    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
133    
134          SUBROUTINE MNC_DIM_UNLIM_SIZE(
135         I     fname,
136         I     unlim_sz,
137         I     myThid )
138    
139          implicit none
140    #include "netcdf.inc"
141    #include "mnc_common.h"
142    #include "EEPARAMS.h"
143    
144    C     Arguments
145          integer myThid, unlim_sz
146          character*(*) fname
147    
148    C     Functions
149          integer ILNBLNK, IFNBLNK
150    
151    C     Local Variables
152          integer i,j, nf, indf, fid, unlimid, err
153          character*(MAX_LEN_MBUF) msgbuf
154    
155          nf = ILNBLNK(fname)
156    
157    C     Verify that the file exists
158          CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
159          IF (indf .LT. 1) THEN
160            write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
161         &       ''' does not exist'
162            CALL print_error(msgbuf, mythid)
163            stop 'ABNORMAL END: S/R MNC_DIM_UNLIM_SIZE'
164          ENDIF
165          fid = mnc_f_info(indf,2)
166    
167    C     Find the unlimited dim and its current size
168          unlim_sz = -1
169          DO i = 1,mnc_f_alld(indf,1)
170            j = mnc_f_alld(indf,i+1)
171            IF (mnc_d_size(j) .EQ. -1) THEN
172              unlimid = mnc_d_ids(j)
173              err = NF_INQ_DIMLEN(fid, unlimid, unlim_sz)
174              write(msgbuf,'(3a)') 'MNC_DIM_UNLIM_SIZE ERROR: cannot ',
175         &         'determine unlimited dim size in file ''', fname(1:nf)
176              CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
177              RETURN
178            ENDIF
179          ENDDO
180    
181          RETURN
182          END
183    
184    
185    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
186    
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22