pkg/mnc/mnc_dim.F

C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_dim.F,v 1.7 2004/03/19 03:28:36 edhill Exp $
C $Name:  $
      
#include "MNC_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

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

C     !DESCRIPTION:
C     Creates a NetCDF dimension within an existing NetCDF file

C     !INPUT PARAMETERS:
C     Arguments
      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
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     Creates a NetCDF dimension within an existing NetCDF file

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

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

C     Functions
      integer ILNBLNK, IFNBLNK

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

      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, 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)

      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-|--+----|

      SUBROUTINE MNC_DIM_UNLIM_SIZE( 
     I     fname, 
     I     unlim_sz, 
     I     myThid )

      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     Arguments
      integer myThid, unlim_sz
      character*(*) fname

C     Functions
      integer ILNBLNK, IFNBLNK

C     Local Variables
      integer i,j, nf, indf, fid, unlimid, err
      character*(MAX_LEN_MBUF) msgbuf

      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.8	C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_dim.F,v 1.7 2004/03/19 03:28:36 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.1
8	edhill	1.8	CBOP
9			C !ROUTINE: MNC_DIM_INIT
10			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			C Creates a NetCDF dimension within an existing NetCDF file
19
20			C !INPUT PARAMETERS:
21	edhill	1.3	C Arguments
22			integer myThid, dlen
23			character() fname, dname
24	edhill	1.8	CEOP
25	edhill	1.3
26	edhill	1.7	CALL MNC_DIM_INIT_ALL(fname, dname, dlen, 'Y', myThid)
27	edhill	1.3
28			RETURN
29			END
30
31
32	edhill	1.4	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
33	edhill	1.3
34	edhill	1.8	CBOP
35			C !ROUTINE: MNC_DIM_INIT_ALL
36			C !INTERFACE:
37	edhill	1.3	SUBROUTINE MNC_DIM_INIT_ALL(
38			I fname,
39			I dname,
40			I dlen,
41	edhill	1.7	I doWrite,
42			I myThid )
43	edhill	1.3
44	edhill	1.8	C !DESCRIPTION:
45			C Creates a NetCDF dimension within an existing NetCDF file
46
47			C !USES:
48	edhill	1.1	implicit none
49	edhill	1.3	#include "netcdf.inc"
50	edhill	1.1	#include "mnc_common.h"
51			#include "EEPARAMS.h"
52
53	edhill	1.8	C !INPUT PARAMETERS:
54	edhill	1.3	integer myThid, dlen
55			character() fname, dname
56			character*(1) doWrite
57	edhill	1.1
58			C Functions
59	edhill	1.3	integer ILNBLNK, IFNBLNK
60	edhill	1.1
61	edhill	1.8	C !LOCAL VARIABLES:
62	edhill	1.3	integer i,j, indf,indd, n,nf, dnf,dnl, ntmp, idd, err, tlen
63	edhill	1.1	character*(MAX_LEN_MBUF) msgbuf
64	edhill	1.8	CEOP
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
134			SUBROUTINE MNC_DIM_UNLIM_SIZE(
135			I fname,
136	edhill	1.7	I unlim_sz,
137			I myThid )
138	edhill	1.6
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	edhill	1.7	CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
159	edhill	1.6	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	edhill	1.7	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
177	edhill	1.6	RETURN
178			ENDIF
179			ENDDO
180
181			RETURN
182			END
183
184
185			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
186	edhill	1.1