/[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.3 by edhill, Sun Jan 25 00:22:57 2004 UTC revision 1.12 by edhill, Sat Dec 18 19:13:31 2004 UTC
# Line 3  C $Name$ Line 3  C $Name$
3                
4  #include "MNC_OPTIONS.h"  #include "MNC_OPTIONS.h"
5                
6  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    CBOP 0
8    C     !ROUTINE: MNC_DIM_INIT
9    
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     Create a dimension within the MNC look-up tables.
19    
20  C     Arguments  C     !INPUT PARAMETERS:
21        integer myThid, dlen        integer myThid, dlen
22        character*(*) fname, dname        character*(*) fname, dname
23    CEOP
24    
25        CALL MNC_DIM_INIT_ALL(myThid, fname, dname, dlen, 'Y')        CALL MNC_DIM_INIT_ALL(fname, dname, dlen, 'Y', myThid)
26    
27        RETURN        RETURN
28        END        END
29    
30    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
31    CBOP 1
32    C     !ROUTINE: MNC_DIM_INIT_ALL
33    
34  C==================================================================  C     !INTERFACE:
   
35        SUBROUTINE MNC_DIM_INIT_ALL(        SUBROUTINE MNC_DIM_INIT_ALL(
      I     myThid,  
36       I     fname,       I     fname,
37       I     dname,       I     dname,
38       I     dlen,       I     dlen,
39       I     doWrite )       I     doWrite,
40         I     myThid )
41    
42    C     !DESCRIPTION:
43    C     Create a dimension within the MNC look-up tables.
44    
45    C     !USES:
46          implicit none
47    
48    C     !INPUT PARAMETERS:
49          integer myThid, dlen
50          character*(*) fname, dname
51          character*(1) doWrite
52    CEOP
53    
54          CALL MNC_DIM_INIT_ALL_CV(fname, dname, dlen, 'Y', -1,-1, myThid)
55          
56          RETURN
57          END
58    
59    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
60    CBOP 1
61    C     !ROUTINE: MNC_DIM_INIT_ALL_CV
62    
63    C     !INTERFACE:
64          SUBROUTINE MNC_DIM_INIT_ALL_CV(
65         I     fname,
66         I     dname,
67         I     dlen,
68         I     doWrite,
69         I     bi,bj,
70         I     myThid )
71    
72    C     !DESCRIPTION:
73    C     Create a dimension within the MNC look-up tables.
74    
75    C     !USES:
76        implicit none        implicit none
77  #include "netcdf.inc"  #include "netcdf.inc"
78  #include "mnc_common.h"  #include "mnc_common.h"
79  #include "EEPARAMS.h"  #include "EEPARAMS.h"
80    
81  C     Arguments  C     !INPUT PARAMETERS:
82        integer myThid, dlen        integer myThid, dlen, bi,bj
83        character*(*) fname, dname        character*(*) fname, dname
84        character*(1) doWrite        character*(1) doWrite
85    CEOP
86    
87    C     !LOCAL VARIABLES:
88          integer i,j, indf,indd, n,nf, dnf,dnl
89          integer ntmp, idd, err, tlen
90          character*(MAX_LEN_MBUF) msgbuf
91    
92  C     Functions  C     Functions
93        integer ILNBLNK, IFNBLNK        integer ILNBLNK, IFNBLNK
94    
 C     Local Variables  
       integer i,j, indf,indd, n,nf, dnf,dnl, ntmp, idd, err, tlen  
       character*(MAX_LEN_MBUF) msgbuf  
   
95        nf = ILNBLNK(fname)        nf = ILNBLNK(fname)
96    
97        dnf = IFNBLNK(dname)        dnf = IFNBLNK(dname)
98        dnl = ILNBLNK(dname)        dnl = ILNBLNK(dname)
99    
100  C     Verify that the file exists  C     Verify that the file exists
101        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)
102        IF ( indf .LT. 1 ) THEN        IF ( indf .LT. 1 ) THEN
103          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
104       &       ''' does not exist'       &       ''' does not exist'
# Line 64  C     Verify that the file exists Line 109  C     Verify that the file exists
109  C     Verify that the dim is not currently defined within the file  C     Verify that the dim is not currently defined within the file
110        n = mnc_f_alld(indf,1)        n = mnc_f_alld(indf,1)
111        DO i = 1,n        DO i = 1,n
         ntmp = ILNBLNK(mnc_d_names(j))  
112          j = mnc_f_alld(indf,i+1)          j = mnc_f_alld(indf,i+1)
113            ntmp = ILNBLNK(mnc_d_names(j))
114          IF ((ntmp .EQ. (dnl-dnf+1))          IF ((ntmp .EQ. (dnl-dnf+1))
115       &       .AND. (dname(dnf:dnl) .EQ. mnc_d_names(j)(1:n))) THEN       &       .AND. (dname(dnf:dnl) .EQ. mnc_d_names(j)(1:ntmp))) THEN
116            write(msgbuf,'(5a)') 'MNC ERROR: dimension ''',            IF (mnc_d_size(j) .NE. dlen) THEN
117       &         dname(dnf:dnl),              IF ((mnc_d_size(j) .GT. 0) .OR. (dlen .GT. 0)) THEN
118       &         ''' already exists within file ''', fname(1:nf),                write(msgbuf,'(5a)') 'MNC ERROR: dimension ''',
119       &         ''' and cannot be re-initalized'       &             dname(dnf:dnl), ''' already exists within file ''',
120            CALL print_error( msgbuf, mythid )       &             fname(1:nf), ''' and its size cannot be changed'
121            stop 'ABNORMAL END: S/R MNC_DIM_INIT'                CALL print_error(msgbuf, mythid)
122                  stop 'ABNORMAL END: S/R MNC_DIM_INIT'
123                ELSE
124    C             Its OK, the names are the same and both are specifying the
125    C             unlimited dimension
126                  RETURN
127                ENDIF
128              ELSE
129    C           Its OK, the names and sizes are identical
130                RETURN
131              ENDIF
132          ENDIF          ENDIF
133        ENDDO        ENDDO
134    
135        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)
136    
137  C     Create the dim within the file  C     Create the dim within the file
138        IF (doWrite(1:1) .EQ. 'Y') THEN        IF (doWrite(1:1) .EQ. 'Y') THEN
# Line 85  C     Create the dim within the file Line 140  C     Create the dim within the file
140          tlen = dlen          tlen = dlen
141          IF (dlen .LT. 1)  tlen = NF_UNLIMITED          IF (dlen .LT. 1)  tlen = NF_UNLIMITED
142    
143          CALL MNC_FILE_REDEF(myThid, fname)          CALL MNC_FILE_REDEF(fname, myThid)
144          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)
145          write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',          write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',
146       &       'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)       &       'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)
147          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
148    
149    C       Create and write the associated CF-convention
150    C       coordinate variable
151            IF (bi .GT. -1) THEN
152              CALL MNC_CW_WRITE_CVAR(fname, dname(dnf:dnl),
153         &         mnc_f_info(indf,2), idd, bi, bj, myThid)
154            ENDIF
155    
156        ENDIF        ENDIF
157    
# Line 103  C     Add to tables Line 165  C     Add to tables
165        RETURN        RETURN
166        END        END
167    
168    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
169    CBOP 1
170    C     !ROUTINE: MNC_DIM_UNLIM_SIZE
171    
172    C     !INTERFACE:
173          SUBROUTINE MNC_DIM_UNLIM_SIZE(
174         I     fname,
175         I     unlim_sz,
176         I     myThid )
177    
178    C     !DESCRIPTION:
179    C     Get the size of the unlimited dimension.
180          
181    C     !USES:
182          implicit none
183    #include "netcdf.inc"
184    #include "mnc_common.h"
185    #include "EEPARAMS.h"
186    
187    C     !INPUT PARAMETERS:
188          integer myThid, unlim_sz
189          character*(*) fname
190    CEOP
191    
192    C     !LOCAL VARIABLES:
193          integer i,j, nf, indf, fid, unlimid, err
194          character*(MAX_LEN_MBUF) msgbuf
195    
196    C     Functions
197          integer ILNBLNK
198    
199          nf = ILNBLNK(fname)
200    
201    C     Verify that the file exists
202          CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
203          IF (indf .LT. 1) THEN
204            write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
205         &       ''' does not exist'
206            CALL print_error(msgbuf, mythid)
207            stop 'ABNORMAL END: S/R MNC_DIM_UNLIM_SIZE'
208          ENDIF
209          fid = mnc_f_info(indf,2)
210    
211    C     Find the unlimited dim and its current size
212          unlim_sz = -1
213          DO i = 1,mnc_f_alld(indf,1)
214            j = mnc_f_alld(indf,i+1)
215            IF (mnc_d_size(j) .EQ. -1) THEN
216              unlimid = mnc_d_ids(j)
217              err = NF_INQ_DIMLEN(fid, unlimid, unlim_sz)
218              write(msgbuf,'(3a)') 'MNC_DIM_UNLIM_SIZE ERROR: cannot ',
219         &         'determine unlimited dim size in file ''', fname(1:nf)
220              CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
221              RETURN
222            ENDIF
223          ENDDO
224    
225          RETURN
226          END
227    
228    
229    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
230    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22