/[MITgcm]/MITgcm/pkg/mnc/mnc_cw_udim.F
ViewVC logotype

Contents of /MITgcm/pkg/mnc/mnc_cw_udim.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.9 - (show annotations) (download)
Fri Mar 10 05:50:23 2006 UTC (18 years, 2 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, checkpoint58u_post, checkpoint58w_post, checkpoint58r_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint58q_post, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59, checkpoint58f_post, checkpoint58d_post, checkpoint58c_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58b_post, checkpoint58m_post
Changes since 1.8: +2 -2 lines
various mnc cleanups and improvements:
 + shrink lookup tables by factor of ~4
 + better error reporting when running out of lookup space
 + able to handle longer path/file names (up to 500 chars)

1 C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_cw_udim.F,v 1.8 2005/09/10 18:30:07 edhill Exp $
2 C $Name: $
3
4 #include "MNC_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP 0
8 C !ROUTINE: MNC_CW_SET_UDIM
9
10 C !INTERFACE:
11 SUBROUTINE MNC_CW_SET_UDIM(
12 I fgname,
13 I nudim,
14 I myThid )
15
16 C !DESCRIPTION:
17 C For a specified file group name, set the size of the NetCDF
18 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 C !USES:
31 implicit none
32 #include "mnc_common.h"
33 #include "EEPARAMS.h"
34
35 C !INPUT PARAMETERS:
36 integer nudim, myThid
37 character*(*) fgname
38 CEOP
39
40 C !LOCAL VARIABLES:
41 integer fgf,fgl, indfg
42 character*(MAX_LEN_MBUF) msgbuf
43
44 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 IF (indfg .LT. 1) THEN
52 CALL MNC_GET_NEXT_EMPTY_IND(
53 & MNC_MAX_ID, mnc_cw_fgnm, 'mnc_cw_fgnm', indfg, myThid)
54 mnc_cw_fgnm(indfg)(1:(fgl-fgf+1)) = fgname(fgf:fgl)
55 mnc_cw_fgud(indfg) = 0
56 mnc_cw_fgig(indfg) = 0
57 ENDIF
58 IF (nudim .GT. 0) THEN
59 mnc_cw_fgig(indfg) = 0
60 mnc_cw_fgud(indfg) = nudim
61 RETURN
62 ENDIF
63 IF (nudim .EQ. 0) THEN
64 mnc_cw_fgig(indfg) = 0
65 RETURN
66 ENDIF
67 IF (nudim .EQ. -1) THEN
68 mnc_cw_fgig(indfg) = 1
69 mnc_cw_fgud(indfg) = mnc_cw_fgud(indfg) + 1
70 RETURN
71 ENDIF
72 write(msgbuf,'(3a,i,a)')
73 & '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
79 RETURN
80 END
81
82 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
83 CBOP 0
84 C !ROUTINE: MNC_CW_GET_UDIM
85
86 C !INTERFACE:
87 SUBROUTINE MNC_CW_GET_UDIM(
88 I fgname,
89 O nudim,
90 I myThid )
91
92 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 implicit none
98 #include "mnc_common.h"
99 #include "EEPARAMS.h"
100
101 C !INPUT PARAMETERS:
102 integer nudim, myThid
103 character*(*) fgname
104 CEOP
105
106 C !LOCAL VARIABLES:
107 integer fgf,fgl, indfg
108 character*(MAX_LEN_MBUF) msgbuf
109
110 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 & 'MNC_CW_GET_UDIM ERROR: file group name ''',
119 & fgname(fgf:fgl), ''' is not defined'
120 CALL print_error(msgbuf, mythid)
121 STOP 'ABNORMAL END: S/R MNC_CW_GET_UDIM'
122 ENDIF
123 nudim = mnc_cw_fgud(indfg)
124
125 RETURN
126 END
127
128 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

  ViewVC Help
Powered by ViewVC 1.1.22