pkg/mnc/mnc_dim.F

C $Header: /u/u3/gcmpack/MITgcm/pkg/mnc/mnc_dim.F,v 1.5 2004/02/04 05:45:09 edhill Exp $
C $Name:  $
      
#include "MNC_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_DIM_INIT( 
     I     myThid, 
     I     fname, 
     I     dname, 
     I     dlen )

C     Arguments
      integer myThid, dlen
      character*(*) fname, dname

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

      RETURN
      END


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

      SUBROUTINE MNC_DIM_INIT_ALL( 
     I     myThid, 
     I     fname, 
     I     dname, 
     I     dlen, 
     I     doWrite ) 

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

C     Arguments
      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

      nf = ILNBLNK(fname)

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

C     Verify that the file exists
      CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
      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(myThid, MNC_MAX_ID, mnc_d_names, indd)

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(myThid, fname)
        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(myThid, err, msgbuf)

      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     myThid, 
     I     fname, 
     I     unlim_sz )

      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(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
      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(myThid, err, msgbuf)
          RETURN
        ENDIF
      ENDDO

      RETURN
      END


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

1	edhill	1.6	C $Header: /u/u3/gcmpack/MITgcm/pkg/mnc/mnc_dim.F,v 1.5 2004/02/04 05:45:09 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			SUBROUTINE MNC_DIM_INIT(
9			I myThid,
10	edhill	1.2	I fname,
11	edhill	1.1	I dname,
12			I dlen )
13
14	edhill	1.3	C Arguments
15			integer myThid, dlen
16			character() fname, dname
17
18			CALL MNC_DIM_INIT_ALL(myThid, fname, dname, dlen, 'Y')
19
20			RETURN
21			END
22
23
24	edhill	1.4	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
25	edhill	1.3
26			SUBROUTINE MNC_DIM_INIT_ALL(
27			I myThid,
28			I fname,
29			I dname,
30			I dlen,
31			I doWrite )
32
33	edhill	1.1	implicit none
34	edhill	1.3	#include "netcdf.inc"
35	edhill	1.1	#include "mnc_common.h"
36			#include "EEPARAMS.h"
37
38			C Arguments
39	edhill	1.3	integer myThid, dlen
40			character() fname, dname
41			character*(1) doWrite
42	edhill	1.1
43			C Functions
44	edhill	1.3	integer ILNBLNK, IFNBLNK
45	edhill	1.1
46			C Local Variables
47	edhill	1.3	integer i,j, indf,indd, n,nf, dnf,dnl, ntmp, idd, err, tlen
48	edhill	1.1	character*(MAX_LEN_MBUF) msgbuf
49
50	edhill	1.2	nf = ILNBLNK(fname)
51	edhill	1.3
52			dnf = IFNBLNK(dname)
53			dnl = ILNBLNK(dname)
54	edhill	1.2
55			C Verify that the file exists
56			CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
57			IF ( indf .LT. 1 ) THEN
58			write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
59			& ''' does not exist'
60	edhill	1.1	CALL print_error( msgbuf, mythid )
61	edhill	1.2	stop 'ABNORMAL END: S/R MNC_DIM_INIT'
62	edhill	1.1	ENDIF
63	edhill	1.2
64			C Verify that the dim is not currently defined within the file
65			n = mnc_f_alld(indf,1)
66			DO i = 1,n
67	edhill	1.5	j = mnc_f_alld(indf,i+1)
68	edhill	1.3	ntmp = ILNBLNK(mnc_d_names(j))
69			IF ((ntmp .EQ. (dnl-dnf+1))
70	edhill	1.5	& .AND. (dname(dnf:dnl) .EQ. mnc_d_names(j)(1:ntmp))) THEN
71			IF (mnc_d_size(j) .NE. dlen) THEN
72			IF ((mnc_d_size(j) .GT. 0) .OR. (dlen .GT. 0)) THEN
73			write(msgbuf,'(5a)') 'MNC ERROR: dimension ''',
74			& dname(dnf:dnl), ''' already exists within file ''',
75			& fname(1:nf), ''' and its size cannot be changed'
76			CALL print_error(msgbuf, mythid)
77			stop 'ABNORMAL END: S/R MNC_DIM_INIT'
78			ELSE
79			C Its OK, the names are the same and both are specifying the
80			C unlimited dimension
81			RETURN
82			ENDIF
83			ELSE
84			C Its OK, the names and sizes are identical
85			RETURN
86			ENDIF
87	edhill	1.2	ENDIF
88			ENDDO
89
90			CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_d_names, indd)
91	edhill	1.1
92	edhill	1.3	C Create the dim within the file
93			IF (doWrite(1:1) .EQ. 'Y') THEN
94
95			tlen = dlen
96			IF (dlen .LT. 1) tlen = NF_UNLIMITED
97
98			CALL MNC_FILE_REDEF(myThid, fname)
99			err = NF_DEF_DIM(mnc_f_info(indf,2), dname(dnf:dnl), tlen, idd)
100			write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',
101			& 'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)
102			CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
103
104	edhill	1.1	ENDIF
105
106			C Add to tables
107	edhill	1.3	mnc_d_names(indd)(1:(dnl-dnf+1)) = dname(dnf:dnl)
108	edhill	1.2	mnc_d_size(indd) = dlen
109	edhill	1.3	mnc_d_ids(indd) = idd
110	edhill	1.2	mnc_f_alld(indf,1) = n + 1
111			mnc_f_alld(indf,n+2) = indd
112	edhill	1.1
113			RETURN
114			END
115	edhill	1.6
116			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
117
118			SUBROUTINE MNC_DIM_UNLIM_SIZE(
119			I myThid,
120			I fname,
121			I unlim_sz )
122
123			implicit none
124			#include "netcdf.inc"
125			#include "mnc_common.h"
126			#include "EEPARAMS.h"
127
128			C Arguments
129			integer myThid, unlim_sz
130			character() fname
131
132			C Functions
133			integer ILNBLNK, IFNBLNK
134
135			C Local Variables
136			integer i,j, nf, indf, fid, unlimid, err
137			character*(MAX_LEN_MBUF) msgbuf
138
139			nf = ILNBLNK(fname)
140
141			C Verify that the file exists
142			CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
143			IF (indf .LT. 1) THEN
144			write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
145			& ''' does not exist'
146			CALL print_error(msgbuf, mythid)
147			stop 'ABNORMAL END: S/R MNC_DIM_UNLIM_SIZE'
148			ENDIF
149			fid = mnc_f_info(indf,2)
150
151			C Find the unlimited dim and its current size
152			unlim_sz = -1
153			DO i = 1,mnc_f_alld(indf,1)
154			j = mnc_f_alld(indf,i+1)
155			IF (mnc_d_size(j) .EQ. -1) THEN
156			unlimid = mnc_d_ids(j)
157			err = NF_INQ_DIMLEN(fid, unlimid, unlim_sz)
158			write(msgbuf,'(3a)') 'MNC_DIM_UNLIM_SIZE ERROR: cannot ',
159			& 'determine unlimited dim size in file ''', fname(1:nf)
160			CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
161			RETURN
162			ENDIF
163			ENDDO
164
165			RETURN
166			END
167
168
169			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
170	edhill	1.1