pkg/mnc/mnc_dim.F

C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_dim.F,v 1.8 2004/03/28 19:28:34 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     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
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
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

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

C     !LOCAL VARIABLES:
      integer i,j, indf,indd, n,nf, dnf,dnl
      integer ntmp, idd, err, tlen
      character*(MAX_LEN_MBUF) msgbuf
CEOP
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, 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-|--+----|
CBOP
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

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

      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.9	C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_dim.F,v 1.8 2004/03/28 19:28:34 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.8	CBOP
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.8	CBOP
33			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.1
57	edhill	1.8	C !LOCAL VARIABLES:
58	edhill	1.9	integer i,j, indf,indd, n,nf, dnf,dnl
59			integer ntmp, idd, err, tlen
60	edhill	1.1	character*(MAX_LEN_MBUF) msgbuf
61	edhill	1.8	CEOP
62	edhill	1.9	C Functions
63			integer ILNBLNK, IFNBLNK
64	edhill	1.1
65	edhill	1.2	nf = ILNBLNK(fname)
66	edhill	1.3
67			dnf = IFNBLNK(dname)
68			dnl = ILNBLNK(dname)
69	edhill	1.2
70			C Verify that the file exists
71	edhill	1.7	CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
72	edhill	1.2	IF ( indf .LT. 1 ) THEN
73			write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
74			& ''' does not exist'
75	edhill	1.1	CALL print_error( msgbuf, mythid )
76	edhill	1.2	stop 'ABNORMAL END: S/R MNC_DIM_INIT'
77	edhill	1.1	ENDIF
78	edhill	1.2
79			C Verify that the dim is not currently defined within the file
80			n = mnc_f_alld(indf,1)
81			DO i = 1,n
82	edhill	1.5	j = mnc_f_alld(indf,i+1)
83	edhill	1.3	ntmp = ILNBLNK(mnc_d_names(j))
84			IF ((ntmp .EQ. (dnl-dnf+1))
85	edhill	1.5	& .AND. (dname(dnf:dnl) .EQ. mnc_d_names(j)(1:ntmp))) THEN
86			IF (mnc_d_size(j) .NE. dlen) THEN
87			IF ((mnc_d_size(j) .GT. 0) .OR. (dlen .GT. 0)) THEN
88			write(msgbuf,'(5a)') 'MNC ERROR: dimension ''',
89			& dname(dnf:dnl), ''' already exists within file ''',
90			& fname(1:nf), ''' and its size cannot be changed'
91			CALL print_error(msgbuf, mythid)
92			stop 'ABNORMAL END: S/R MNC_DIM_INIT'
93			ELSE
94			C Its OK, the names are the same and both are specifying the
95			C unlimited dimension
96			RETURN
97			ENDIF
98			ELSE
99			C Its OK, the names and sizes are identical
100			RETURN
101			ENDIF
102	edhill	1.2	ENDIF
103			ENDDO
104
105	edhill	1.7	CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_d_names, indd, myThid)
106	edhill	1.1
107	edhill	1.3	C Create the dim within the file
108			IF (doWrite(1:1) .EQ. 'Y') THEN
109
110			tlen = dlen
111			IF (dlen .LT. 1) tlen = NF_UNLIMITED
112
113	edhill	1.7	CALL MNC_FILE_REDEF(fname, myThid)
114	edhill	1.3	err = NF_DEF_DIM(mnc_f_info(indf,2), dname(dnf:dnl), tlen, idd)
115			write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',
116			& 'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)
117	edhill	1.7	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
118	edhill	1.3
119	edhill	1.1	ENDIF
120
121			C Add to tables
122	edhill	1.3	mnc_d_names(indd)(1:(dnl-dnf+1)) = dname(dnf:dnl)
123	edhill	1.2	mnc_d_size(indd) = dlen
124	edhill	1.3	mnc_d_ids(indd) = idd
125	edhill	1.2	mnc_f_alld(indf,1) = n + 1
126			mnc_f_alld(indf,n+2) = indd
127	edhill	1.1
128			RETURN
129			END
130	edhill	1.6
131			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
132	edhill	1.9	CBOP
133			C !ROUTINE: MNC_DIM_UNLIM_SIZE
134	edhill	1.6
135	edhill	1.9	C !INTERFACE:
136	edhill	1.6	SUBROUTINE MNC_DIM_UNLIM_SIZE(
137			I fname,
138	edhill	1.7	I unlim_sz,
139			I myThid )
140	edhill	1.6
141	edhill	1.9	C !DESCRIPTION:
142			C Get the size of the unlimited dimension.
143
144			C !USES:
145	edhill	1.6	implicit none
146			#include "netcdf.inc"
147			#include "mnc_common.h"
148			#include "EEPARAMS.h"
149
150	edhill	1.9	C !INPUT PARAMETERS:
151	edhill	1.6	integer myThid, unlim_sz
152			character() fname
153
154	edhill	1.9	C !LOCAL VARIABLES:
155			integer i,j, nf, indf, fid, unlimid, err
156			character*(MAX_LEN_MBUF) msgbuf
157			CEOP
158	edhill	1.6	C Functions
159			integer ILNBLNK, IFNBLNK
160
161			nf = ILNBLNK(fname)
162
163			C Verify that the file exists
164	edhill	1.7	CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
165	edhill	1.6	IF (indf .LT. 1) THEN
166			write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
167			& ''' does not exist'
168			CALL print_error(msgbuf, mythid)
169			stop 'ABNORMAL END: S/R MNC_DIM_UNLIM_SIZE'
170			ENDIF
171			fid = mnc_f_info(indf,2)
172
173			C Find the unlimited dim and its current size
174			unlim_sz = -1
175			DO i = 1,mnc_f_alld(indf,1)
176			j = mnc_f_alld(indf,i+1)
177			IF (mnc_d_size(j) .EQ. -1) THEN
178			unlimid = mnc_d_ids(j)
179			err = NF_INQ_DIMLEN(fid, unlimid, unlim_sz)
180			write(msgbuf,'(3a)') 'MNC_DIM_UNLIM_SIZE ERROR: cannot ',
181			& 'determine unlimited dim size in file ''', fname(1:nf)
182	edhill	1.7	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
183	edhill	1.6	RETURN
184			ENDIF
185			ENDDO
186
187			RETURN
188			END
189
190
191			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
192	edhill	1.1