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

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

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

Revision 1.10 - (hide annotations) (download)
Fri Apr 2 16:12:48 2004 UTC (20 years, 1 month ago) by edhill
Branch: MAIN
CVS Tags: checkpoint52n_post, checkpoint53d_post, checkpoint54a_pre, checkpoint55c_post, checkpoint54e_post, checkpoint54a_post, checkpoint53c_post, checkpoint55d_pre, checkpoint55j_post, checkpoint56b_post, checkpoint55h_post, checkpoint54b_post, checkpoint53b_pre, checkpoint55b_post, checkpoint54d_post, checkpoint56c_post, checkpoint52m_post, checkpoint55, checkpoint53a_post, checkpoint57a_post, checkpoint54, checkpoint54f_post, checkpoint53b_post, checkpoint55g_post, checkpoint55f_post, checkpoint57a_pre, checkpoint55i_post, checkpoint57, checkpoint56, checkpoint53, checkpoint53g_post, checkpoint55e_post, checkpoint53f_post, checkpoint55a_post, checkpoint53d_pre, checkpoint54c_post, checkpoint56a_post, checkpoint55d_post
Changes since 1.9: +8 -6 lines 
 o more comments for the api_reference (protex)
1 edhill 1.10 C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_dim.F,v 1.9 2004/03/29 03:33:51 edhill Exp $
2 edhill 1.1 C $Name: $
3    
4     #include "MNC_OPTIONS.h"
5    
6 edhill 1.4 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 edhill 1.10 CBOP 0
8 edhill 1.8 C !ROUTINE: MNC_DIM_INIT
9 edhill 1.9
10 edhill 1.8 C !INTERFACE:
11 edhill 1.1 SUBROUTINE MNC_DIM_INIT(
12 edhill 1.2 I fname,
13 edhill 1.1 I dname,
14 edhill 1.7 I dlen,
15     I myThid )
16 edhill 1.1
17 edhill 1.8 C !DESCRIPTION:
18 edhill 1.9 C Create a dimension within the MNC look-up tables.
19 edhill 1.8
20     C !INPUT PARAMETERS:
21 edhill 1.3 integer myThid, dlen
22     character*(*) fname, dname
23 edhill 1.8 CEOP
24 edhill 1.3
25 edhill 1.7 CALL MNC_DIM_INIT_ALL(fname, dname, dlen, 'Y', myThid)
26 edhill 1.3
27     RETURN
28     END
29    
30    
31 edhill 1.4 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
32 edhill 1.10 CBOP 1
33 edhill 1.8 C !ROUTINE: MNC_DIM_INIT_ALL
34 edhill 1.9
35 edhill 1.8 C !INTERFACE:
36 edhill 1.3 SUBROUTINE MNC_DIM_INIT_ALL(
37     I fname,
38     I dname,
39     I dlen,
40 edhill 1.7 I doWrite,
41     I myThid )
42 edhill 1.3
43 edhill 1.8 C !DESCRIPTION:
44 edhill 1.9 C Create a dimension within the MNC look-up tables.
45 edhill 1.8
46     C !USES:
47 edhill 1.1 implicit none
48 edhill 1.3 #include "netcdf.inc"
49 edhill 1.1 #include "mnc_common.h"
50     #include "EEPARAMS.h"
51    
52 edhill 1.8 C !INPUT PARAMETERS:
53 edhill 1.3 integer myThid, dlen
54     character*(*) fname, dname
55     character*(1) doWrite
56 edhill 1.10 CEOP
57 edhill 1.1
58 edhill 1.8 C !LOCAL VARIABLES:
59 edhill 1.9 integer i,j, indf,indd, n,nf, dnf,dnl
60     integer ntmp, idd, err, tlen
61 edhill 1.1 character*(MAX_LEN_MBUF) msgbuf
62 edhill 1.10
63 edhill 1.9 C Functions
64     integer ILNBLNK, IFNBLNK
65 edhill 1.1
66 edhill 1.2 nf = ILNBLNK(fname)
67 edhill 1.3
68     dnf = IFNBLNK(dname)
69     dnl = ILNBLNK(dname)
70 edhill 1.2
71     C Verify that the file exists
72 edhill 1.7 CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
73 edhill 1.2 IF ( indf .LT. 1 ) THEN
74     write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
75     & ''' does not exist'
76 edhill 1.1 CALL print_error( msgbuf, mythid )
77 edhill 1.2 stop 'ABNORMAL END: S/R MNC_DIM_INIT'
78 edhill 1.1 ENDIF
79 edhill 1.2
80     C Verify that the dim is not currently defined within the file
81     n = mnc_f_alld(indf,1)
82     DO i = 1,n
83 edhill 1.5 j = mnc_f_alld(indf,i+1)
84 edhill 1.3 ntmp = ILNBLNK(mnc_d_names(j))
85     IF ((ntmp .EQ. (dnl-dnf+1))
86 edhill 1.5 & .AND. (dname(dnf:dnl) .EQ. mnc_d_names(j)(1:ntmp))) THEN
87     IF (mnc_d_size(j) .NE. dlen) THEN
88     IF ((mnc_d_size(j) .GT. 0) .OR. (dlen .GT. 0)) THEN
89     write(msgbuf,'(5a)') 'MNC ERROR: dimension ''',
90     & dname(dnf:dnl), ''' already exists within file ''',
91     & fname(1:nf), ''' and its size cannot be changed'
92     CALL print_error(msgbuf, mythid)
93     stop 'ABNORMAL END: S/R MNC_DIM_INIT'
94     ELSE
95     C Its OK, the names are the same and both are specifying the
96     C unlimited dimension
97     RETURN
98     ENDIF
99     ELSE
100     C Its OK, the names and sizes are identical
101     RETURN
102     ENDIF
103 edhill 1.2 ENDIF
104     ENDDO
105    
106 edhill 1.7 CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_d_names, indd, myThid)
107 edhill 1.1
108 edhill 1.3 C Create the dim within the file
109     IF (doWrite(1:1) .EQ. 'Y') THEN
110    
111     tlen = dlen
112     IF (dlen .LT. 1) tlen = NF_UNLIMITED
113    
114 edhill 1.7 CALL MNC_FILE_REDEF(fname, myThid)
115 edhill 1.3 err = NF_DEF_DIM(mnc_f_info(indf,2), dname(dnf:dnl), tlen, idd)
116     write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',
117     & 'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)
118 edhill 1.7 CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
119 edhill 1.3
120 edhill 1.1 ENDIF
121    
122     C Add to tables
123 edhill 1.3 mnc_d_names(indd)(1:(dnl-dnf+1)) = dname(dnf:dnl)
124 edhill 1.2 mnc_d_size(indd) = dlen
125 edhill 1.3 mnc_d_ids(indd) = idd
126 edhill 1.2 mnc_f_alld(indf,1) = n + 1
127     mnc_f_alld(indf,n+2) = indd
128 edhill 1.1
129     RETURN
130     END
131 edhill 1.6
132     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
133 edhill 1.10 CBOP 1
134 edhill 1.9 C !ROUTINE: MNC_DIM_UNLIM_SIZE
135 edhill 1.6
136 edhill 1.9 C !INTERFACE:
137 edhill 1.6 SUBROUTINE MNC_DIM_UNLIM_SIZE(
138     I fname,
139 edhill 1.7 I unlim_sz,
140     I myThid )
141 edhill 1.6
142 edhill 1.9 C !DESCRIPTION:
143     C Get the size of the unlimited dimension.
144    
145     C !USES:
146 edhill 1.6 implicit none
147     #include "netcdf.inc"
148     #include "mnc_common.h"
149     #include "EEPARAMS.h"
150    
151 edhill 1.9 C !INPUT PARAMETERS:
152 edhill 1.6 integer myThid, unlim_sz
153     character*(*) fname
154 edhill 1.10 CEOP
155 edhill 1.6
156 edhill 1.9 C !LOCAL VARIABLES:
157     integer i,j, nf, indf, fid, unlimid, err
158     character*(MAX_LEN_MBUF) msgbuf
159 edhill 1.10
160 edhill 1.6 C Functions
161     integer ILNBLNK, IFNBLNK
162    
163     nf = ILNBLNK(fname)
164    
165     C Verify that the file exists
166 edhill 1.7 CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
167 edhill 1.6 IF (indf .LT. 1) THEN
168     write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
169     & ''' does not exist'
170     CALL print_error(msgbuf, mythid)
171     stop 'ABNORMAL END: S/R MNC_DIM_UNLIM_SIZE'
172     ENDIF
173     fid = mnc_f_info(indf,2)
174    
175     C Find the unlimited dim and its current size
176     unlim_sz = -1
177     DO i = 1,mnc_f_alld(indf,1)
178     j = mnc_f_alld(indf,i+1)
179     IF (mnc_d_size(j) .EQ. -1) THEN
180     unlimid = mnc_d_ids(j)
181     err = NF_INQ_DIMLEN(fid, unlimid, unlim_sz)
182     write(msgbuf,'(3a)') 'MNC_DIM_UNLIM_SIZE ERROR: cannot ',
183     & 'determine unlimited dim size in file ''', fname(1:nf)
184 edhill 1.7 CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
185 edhill 1.6 RETURN
186     ENDIF
187     ENDDO
188    
189     RETURN
190     END
191    
192    
193     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
194 edhill 1.1
  ViewVC Help
Powered by ViewVC 1.1.22