pkg/mnc/mnc_dim.F

C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_dim.F,v 1.13 2005/01/24 04:40:35 edhill Exp $
C $Name:  $
      
#include "MNC_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C     !ROUTINE: MNC_DIM_INIT

C     !INTERFACE:
      SUBROUTINE MNC_DIM_INIT( 
     I     fname, 
     I     dname, 
     I     dlen, 
     I     myThid )

C     !DESCRIPTION:
C     Create a dimension within the MNC look-up tables.

C     !INPUT PARAMETERS:
      integer myThid, dlen
      character*(*) fname, dname
CEOP

      CALL MNC_DIM_INIT_ALL(fname, dname, dlen, 'Y', myThid)

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_DIM_INIT_ALL

C     !INTERFACE:
      SUBROUTINE MNC_DIM_INIT_ALL( 
     I     fname, 
     I     dname, 
     I     dlen, 
     I     doWrite, 
     I     myThid ) 

C     !DESCRIPTION:
C     Create a dimension within the MNC look-up tables.

C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid, dlen
      character*(*) fname, dname
      character*(1) doWrite
CEOP

      CALL MNC_DIM_INIT_ALL_CV(fname,dname,dlen,doWrite,-1,-1,myThid)
      
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_DIM_INIT_ALL_CV

C     !INTERFACE:
      SUBROUTINE MNC_DIM_INIT_ALL_CV( 
     I     fname, 
     I     dname, 
     I     dlen, 
     I     doWrite, 
     I     bi,bj,
     I     myThid ) 

C     !DESCRIPTION:
C     Create a dimension within the MNC look-up tables.

C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     !INPUT PARAMETERS:
      integer myThid, dlen, bi,bj
      character*(*) fname, dname
      character*(1) doWrite
CEOP

C     !LOCAL VARIABLES:
      integer i,j, indf,indd, n,nf, dnf,dnl
      integer ntmp, idd, err, tlen
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer ILNBLNK, IFNBLNK

      nf = ILNBLNK(fname)

      dnf = IFNBLNK(dname)
      dnl = ILNBLNK(dname)

C     Verify that the file exists
      CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
      IF ( indf .LT. 1 ) THEN
        write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
     &       ''' does not exist'
        CALL print_error( msgbuf, mythid )
        stop 'ABNORMAL END: S/R MNC_DIM_INIT'
      ENDIF

C     Verify that the dim is not currently defined within the file
      n = mnc_f_alld(indf,1)
      DO i = 1,n
        j = mnc_f_alld(indf,i+1)
        ntmp = ILNBLNK(mnc_d_names(j))
        IF ((ntmp .EQ. (dnl-dnf+1)) 
     &       .AND. (dname(dnf:dnl) .EQ. mnc_d_names(j)(1:ntmp))) THEN
          IF (mnc_d_size(j) .NE. dlen) THEN
            IF ((mnc_d_size(j) .GT. 0) .OR. (dlen .GT. 0)) THEN
              write(msgbuf,'(5a)') 'MNC ERROR: dimension ''', 
     &             dname(dnf:dnl), ''' already exists within file ''', 
     &             fname(1:nf), ''' and its size cannot be changed'
              CALL print_error(msgbuf, mythid)
              stop 'ABNORMAL END: S/R MNC_DIM_INIT'
            ELSE
C             Its OK, the names are the same and both are specifying the
C             unlimited dimension
              RETURN
            ENDIF
          ELSE
C           Its OK, the names and sizes are identical
            RETURN
          ENDIF
        ENDIF
      ENDDO

      CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_d_names, 
     &     'mnc_d_names', indd, myThid)

C     Create the dim within the file
      IF (doWrite(1:1) .EQ. 'Y') THEN

        tlen = dlen
        IF (dlen .LT. 1)  tlen = NF_UNLIMITED

        CALL MNC_FILE_REDEF(fname, myThid)
        err = NF_DEF_DIM(mnc_f_info(indf,2), dname(dnf:dnl), tlen, idd)
        write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',
     &       'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)
        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)

C       Create and write the associated CF-convention
C       coordinate variable
        IF (bi .GT. -1) THEN
          CALL MNC_CW_WRITE_CVAR(fname, dname(dnf:dnl), 
     &         mnc_f_info(indf,2), idd, bi, bj, myThid)
        ENDIF

      ENDIF

C     Add to tables
      mnc_d_names(indd)(1:(dnl-dnf+1)) = dname(dnf:dnl)
      mnc_d_size(indd) = dlen
      mnc_d_ids(indd) = idd
      mnc_f_alld(indf,1) = n + 1
      mnc_f_alld(indf,n+2) = indd

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_DIM_UNLIM_SIZE

C     !INTERFACE:
      SUBROUTINE MNC_DIM_UNLIM_SIZE( 
     I     fname, 
     I     unlim_sz, 
     I     myThid )

C     !DESCRIPTION:
C     Get the size of the unlimited dimension.
      
C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     !INPUT PARAMETERS:
      integer myThid, unlim_sz
      character*(*) fname
CEOP

C     !LOCAL VARIABLES:
      integer i,j, nf, indf, fid, unlimid, err
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer ILNBLNK

      nf = ILNBLNK(fname)

C     Verify that the file exists
      CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
      IF (indf .LT. 1) THEN
        write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
     &       ''' does not exist'
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: S/R MNC_DIM_UNLIM_SIZE'
      ENDIF
      fid = mnc_f_info(indf,2)

C     Find the unlimited dim and its current size
      unlim_sz = -1
      DO i = 1,mnc_f_alld(indf,1)
        j = mnc_f_alld(indf,i+1)
        IF (mnc_d_size(j) .EQ. -1) THEN
          unlimid = mnc_d_ids(j)
          err = NF_INQ_DIMLEN(fid, unlimid, unlim_sz)
          write(msgbuf,'(3a)') 'MNC_DIM_UNLIM_SIZE ERROR: cannot ',
     &         'determine unlimited dim size in file ''', fname(1:nf)
          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
          RETURN
        ENDIF
      ENDDO

      RETURN
      END


C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

1	edhill	1.14	C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_dim.F,v 1.13 2005/01/24 04:40:35 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	edhill	1.4	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
31	edhill	1.10	CBOP 1
32	edhill	1.8	C !ROUTINE: MNC_DIM_INIT_ALL
33	edhill	1.9
34	edhill	1.8	C !INTERFACE:
35	edhill	1.3	SUBROUTINE MNC_DIM_INIT_ALL(
36			I fname,
37			I dname,
38			I dlen,
39	edhill	1.7	I doWrite,
40			I myThid )
41	edhill	1.3
42	edhill	1.8	C !DESCRIPTION:
43	edhill	1.9	C Create a dimension within the MNC look-up tables.
44	edhill	1.8
45			C !USES:
46	edhill	1.1	implicit none
47	edhill	1.11
48			C !INPUT PARAMETERS:
49			integer myThid, dlen
50			character() fname, dname
51			character*(1) doWrite
52			CEOP
53
54	edhill	1.13	CALL MNC_DIM_INIT_ALL_CV(fname,dname,dlen,doWrite,-1,-1,myThid)
55	edhill	1.11
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
77	edhill	1.3	#include "netcdf.inc"
78	edhill	1.1	#include "mnc_common.h"
79			#include "EEPARAMS.h"
80
81	edhill	1.8	C !INPUT PARAMETERS:
82	edhill	1.11	integer myThid, dlen, bi,bj
83	edhill	1.3	character() fname, dname
84			character*(1) doWrite
85	edhill	1.10	CEOP
86	edhill	1.1
87	edhill	1.8	C !LOCAL VARIABLES:
88	edhill	1.9	integer i,j, indf,indd, n,nf, dnf,dnl
89			integer ntmp, idd, err, tlen
90	edhill	1.1	character*(MAX_LEN_MBUF) msgbuf
91	edhill	1.10
92	edhill	1.9	C Functions
93			integer ILNBLNK, IFNBLNK
94	edhill	1.1
95	edhill	1.2	nf = ILNBLNK(fname)
96	edhill	1.3
97			dnf = IFNBLNK(dname)
98			dnl = ILNBLNK(dname)
99	edhill	1.2
100			C Verify that the file exists
101	edhill	1.7	CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
102	edhill	1.2	IF ( indf .LT. 1 ) THEN
103			write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
104			& ''' does not exist'
105	edhill	1.1	CALL print_error( msgbuf, mythid )
106	edhill	1.2	stop 'ABNORMAL END: S/R MNC_DIM_INIT'
107	edhill	1.1	ENDIF
108	edhill	1.2
109			C Verify that the dim is not currently defined within the file
110			n = mnc_f_alld(indf,1)
111			DO i = 1,n
112	edhill	1.5	j = mnc_f_alld(indf,i+1)
113	edhill	1.3	ntmp = ILNBLNK(mnc_d_names(j))
114			IF ((ntmp .EQ. (dnl-dnf+1))
115	edhill	1.5	& .AND. (dname(dnf:dnl) .EQ. mnc_d_names(j)(1:ntmp))) THEN
116			IF (mnc_d_size(j) .NE. dlen) THEN
117			IF ((mnc_d_size(j) .GT. 0) .OR. (dlen .GT. 0)) THEN
118			write(msgbuf,'(5a)') 'MNC ERROR: dimension ''',
119			& dname(dnf:dnl), ''' already exists within file ''',
120			& fname(1:nf), ''' and its size cannot be changed'
121			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	edhill	1.2	ENDIF
133			ENDDO
134
135	edhill	1.14	CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_d_names,
136			& 'mnc_d_names', indd, myThid)
137	edhill	1.1
138	edhill	1.3	C Create the dim within the file
139			IF (doWrite(1:1) .EQ. 'Y') THEN
140
141			tlen = dlen
142			IF (dlen .LT. 1) tlen = NF_UNLIMITED
143
144	edhill	1.7	CALL MNC_FILE_REDEF(fname, myThid)
145	edhill	1.3	err = NF_DEF_DIM(mnc_f_info(indf,2), dname(dnf:dnl), tlen, idd)
146			write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',
147			& 'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)
148	edhill	1.7	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
149	edhill	1.3
150	edhill	1.11	C Create and write the associated CF-convention
151			C coordinate variable
152			IF (bi .GT. -1) THEN
153			CALL MNC_CW_WRITE_CVAR(fname, dname(dnf:dnl),
154			& mnc_f_info(indf,2), idd, bi, bj, myThid)
155			ENDIF
156
157	edhill	1.1	ENDIF
158
159			C Add to tables
160	edhill	1.3	mnc_d_names(indd)(1:(dnl-dnf+1)) = dname(dnf:dnl)
161	edhill	1.2	mnc_d_size(indd) = dlen
162	edhill	1.3	mnc_d_ids(indd) = idd
163	edhill	1.2	mnc_f_alld(indf,1) = n + 1
164			mnc_f_alld(indf,n+2) = indd
165	edhill	1.1
166			RETURN
167			END
168	edhill	1.6
169			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
170	edhill	1.10	CBOP 1
171	edhill	1.9	C !ROUTINE: MNC_DIM_UNLIM_SIZE
172	edhill	1.6
173	edhill	1.9	C !INTERFACE:
174	edhill	1.6	SUBROUTINE MNC_DIM_UNLIM_SIZE(
175			I fname,
176	edhill	1.7	I unlim_sz,
177			I myThid )
178	edhill	1.6
179	edhill	1.9	C !DESCRIPTION:
180			C Get the size of the unlimited dimension.
181
182			C !USES:
183	edhill	1.6	implicit none
184			#include "netcdf.inc"
185			#include "mnc_common.h"
186			#include "EEPARAMS.h"
187
188	edhill	1.9	C !INPUT PARAMETERS:
189	edhill	1.6	integer myThid, unlim_sz
190			character() fname
191	edhill	1.10	CEOP
192	edhill	1.6
193	edhill	1.9	C !LOCAL VARIABLES:
194			integer i,j, nf, indf, fid, unlimid, err
195			character*(MAX_LEN_MBUF) msgbuf
196	edhill	1.10
197	edhill	1.6	C Functions
198	edhill	1.11	integer ILNBLNK
199	edhill	1.6
200			nf = ILNBLNK(fname)
201
202			C Verify that the file exists
203	edhill	1.7	CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
204	edhill	1.6	IF (indf .LT. 1) THEN
205			write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
206			& ''' does not exist'
207			CALL print_error(msgbuf, mythid)
208			stop 'ABNORMAL END: S/R MNC_DIM_UNLIM_SIZE'
209			ENDIF
210			fid = mnc_f_info(indf,2)
211
212			C Find the unlimited dim and its current size
213			unlim_sz = -1
214			DO i = 1,mnc_f_alld(indf,1)
215			j = mnc_f_alld(indf,i+1)
216			IF (mnc_d_size(j) .EQ. -1) THEN
217			unlimid = mnc_d_ids(j)
218			err = NF_INQ_DIMLEN(fid, unlimid, unlim_sz)
219			write(msgbuf,'(3a)') 'MNC_DIM_UNLIM_SIZE ERROR: cannot ',
220			& 'determine unlimited dim size in file ''', fname(1:nf)
221	edhill	1.7	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
222	edhill	1.6	RETURN
223			ENDIF
224			ENDDO
225
226			RETURN
227			END
228
229
230			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
231	edhill	1.1