pkg/mnc/mnc_cw_udim.F

C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_cw_udim.F,v 1.9 2006/03/10 05:50:23 edhill Exp $
C $Name:  $
      
#include "MNC_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C !ROUTINE: MNC_CW_SET_UDIM

C !INTERFACE:
      SUBROUTINE MNC_CW_SET_UDIM( 
     I     fgname, 
     I     nudim, 
     I     myThid ) 

C     !DESCRIPTION:
C     For a specified file group name, set the size of the NetCDF
C     unlimited (or record) dimension.  The options are:
C     \begin{equation}
C       \label{eq:yo}
C       \mbox{\bf nudim} = \left\{
C         \begin{array}[htb]{cl}
C           >0,  &  \mbox{\small use the specified value} \\
C           0,   &  \mbox{\small use the largest currently defined value} \\
C           -1,  &  \mbox{\small increment the largest value and then use it} \\
C         \end{array}
C         \right.
C     \end{equation}

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

C     !INPUT PARAMETERS:
      integer nudim, myThid
      character*(*) fgname
CEOP

C     !LOCAL VARIABLES:
      integer fgf,fgl, indfg
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer IFNBLNK, ILNBLNK

C     Check that this name is not already defined
      fgf = IFNBLNK(fgname)
      fgl = ILNBLNK(fgname)
      CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
      IF (indfg .LT. 1) THEN
        CALL MNC_GET_NEXT_EMPTY_IND(
     &       MNC_MAX_ID, mnc_cw_fgnm, 'mnc_cw_fgnm', indfg, myThid)
        mnc_cw_fgnm(indfg)(1:(fgl-fgf+1)) = fgname(fgf:fgl)
        mnc_cw_fgud(indfg) = 0
        mnc_cw_fgig(indfg) = 0
      ENDIF
      IF (nudim .GT. 0) THEN
        mnc_cw_fgig(indfg) = 0
        mnc_cw_fgud(indfg) = nudim
        RETURN
      ENDIF
      IF (nudim .EQ. 0) THEN
        mnc_cw_fgig(indfg) = 0
        RETURN
      ENDIF
      IF (nudim .EQ. -1) THEN
        mnc_cw_fgig(indfg) = 1
        mnc_cw_fgud(indfg) = mnc_cw_fgud(indfg) + 1
        RETURN
      ENDIF
      write(msgbuf,'(3a,i10,a)') 
     &     'MNC_CW_SET_UDIM ERROR: for file group name ''', 
     &     fgname(fgf:fgl), ''' the unlim dim ''', nudim, 
     &     ''' is not allowed'
      CALL print_error(msgbuf, mythid)
      STOP 'ABNORMAL END: S/R MNC_CW_SET_UDIM'

      RETURN
      END

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

C !INTERFACE:
      SUBROUTINE MNC_CW_GET_UDIM( 
     I     fgname, 
     O     nudim, 
     I     myThid ) 

C     !DESCRIPTION:
C     For a specified file group name, get the size of the NetCDF
C     unlimited (or record) dimension.

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

C     !INPUT PARAMETERS:
      integer nudim, myThid
      character*(*) fgname
CEOP

C     !LOCAL VARIABLES:
      integer fgf,fgl, indfg
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer IFNBLNK, ILNBLNK

      fgf = IFNBLNK(fgname)
      fgl = ILNBLNK(fgname)
      CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
      IF (indfg .LT. 1) THEN
        write(msgbuf,'(3a)') 
     &       'MNC_CW_GET_UDIM ERROR: file group name ''', 
     &       fgname(fgf:fgl), ''' is not defined'
        CALL print_error(msgbuf, mythid)
        STOP 'ABNORMAL END: S/R MNC_CW_GET_UDIM'
      ENDIF
      nudim = mnc_cw_fgud(indfg)

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1	dfer	1.10	C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_cw_udim.F,v 1.9 2006/03/10 05:50:23 edhill Exp $
2	edhill	1.1	C $Name: $
3
4			#include "MNC_OPTIONS.h"
5
6			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7	edhill	1.4	CBOP 0
8	edhill	1.3	C !ROUTINE: MNC_CW_SET_UDIM
9	edhill	1.1
10	edhill	1.3	C !INTERFACE:
11	edhill	1.1	SUBROUTINE MNC_CW_SET_UDIM(
12			I fgname,
13			I nudim,
14			I myThid )
15
16	edhill	1.3	C !DESCRIPTION:
17			C For a specified file group name, set the size of the NetCDF
18	edhill	1.4	C unlimited (or record) dimension. The options are:
19			C \begin{equation}
20			C \label{eq:yo}
21			C \mbox{\bf nudim} = \left\{
22			C \begin{array}[htb]{cl}
23			C >0, & \mbox{\small use the specified value} \\
24			C 0, & \mbox{\small use the largest currently defined value} \\
25			C -1, & \mbox{\small increment the largest value and then use it} \\
26			C \end{array}
27			C \right.
28			C \end{equation}
29
30	edhill	1.3	C !USES:
31	edhill	1.1	implicit none
32			#include "mnc_common.h"
33			#include "EEPARAMS.h"
34
35	edhill	1.3	C !INPUT PARAMETERS:
36	edhill	1.1	integer nudim, myThid
37			character() fgname
38	edhill	1.4	CEOP
39	edhill	1.1
40	edhill	1.3	C !LOCAL VARIABLES:
41			integer fgf,fgl, indfg
42			character*(MAX_LEN_MBUF) msgbuf
43	edhill	1.4
44	edhill	1.1	C Functions
45			integer IFNBLNK, ILNBLNK
46
47			C Check that this name is not already defined
48			fgf = IFNBLNK(fgname)
49			fgl = ILNBLNK(fgname)
50			CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
51	edhill	1.2	IF (indfg .LT. 1) THEN
52			CALL MNC_GET_NEXT_EMPTY_IND(
53	edhill	1.9	& MNC_MAX_ID, mnc_cw_fgnm, 'mnc_cw_fgnm', indfg, myThid)
54	edhill	1.7	mnc_cw_fgnm(indfg)(1:(fgl-fgf+1)) = fgname(fgf:fgl)
55	edhill	1.5	mnc_cw_fgud(indfg) = 0
56	edhill	1.7	mnc_cw_fgig(indfg) = 0
57	edhill	1.1	ENDIF
58	edhill	1.5	IF (nudim .GT. 0) THEN
59	edhill	1.7	mnc_cw_fgig(indfg) = 0
60	edhill	1.5	mnc_cw_fgud(indfg) = nudim
61			RETURN
62			ENDIF
63	edhill	1.7	IF (nudim .EQ. 0) THEN
64			mnc_cw_fgig(indfg) = 0
65			RETURN
66			ENDIF
67	edhill	1.5	IF (nudim .EQ. -1) THEN
68	edhill	1.7	mnc_cw_fgig(indfg) = 1
69	edhill	1.5	mnc_cw_fgud(indfg) = mnc_cw_fgud(indfg) + 1
70			RETURN
71			ENDIF
72	dfer	1.10	write(msgbuf,'(3a,i10,a)')
73	edhill	1.5	& 'MNC_CW_SET_UDIM ERROR: for file group name ''',
74			& fgname(fgf:fgl), ''' the unlim dim ''', nudim,
75			& ''' is not allowed'
76			CALL print_error(msgbuf, mythid)
77			STOP 'ABNORMAL END: S/R MNC_CW_SET_UDIM'
78	edhill	1.1
79			RETURN
80			END
81
82			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
83	edhill	1.4	CBOP 0
84	edhill	1.3	C !ROUTINE: MNC_CW_GET_UDIM
85	edhill	1.1
86	edhill	1.3	C !INTERFACE:
87	edhill	1.1	SUBROUTINE MNC_CW_GET_UDIM(
88			I fgname,
89			O nudim,
90			I myThid )
91
92	edhill	1.3	C !DESCRIPTION:
93			C For a specified file group name, get the size of the NetCDF
94			C unlimited (or record) dimension.
95
96			C !USES:
97	edhill	1.1	implicit none
98			#include "mnc_common.h"
99			#include "EEPARAMS.h"
100
101	edhill	1.3	C !INPUT PARAMETERS:
102	edhill	1.1	integer nudim, myThid
103			character() fgname
104	edhill	1.4	CEOP
105	edhill	1.1
106	edhill	1.3	C !LOCAL VARIABLES:
107			integer fgf,fgl, indfg
108			character*(MAX_LEN_MBUF) msgbuf
109	edhill	1.4
110	edhill	1.1	C Functions
111			integer IFNBLNK, ILNBLNK
112
113			fgf = IFNBLNK(fgname)
114			fgl = ILNBLNK(fgname)
115			CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
116			IF (indfg .LT. 1) THEN
117			write(msgbuf,'(3a)')
118	edhill	1.5	& 'MNC_CW_GET_UDIM ERROR: file group name ''',
119	edhill	1.1	& fgname(fgf:fgl), ''' is not defined'
120			CALL print_error(msgbuf, mythid)
121	edhill	1.5	STOP 'ABNORMAL END: S/R MNC_CW_GET_UDIM'
122	edhill	1.1	ENDIF
123			nudim = mnc_cw_fgud(indfg)
124
125			RETURN
126			END
127
128			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|